mirror of
https://codeberg.org/h3xx/simplify_static_dir
synced 2024-08-14 23:57:24 +00:00
Unpack @_ first (PBP)
This commit is contained in:
parent
907a7113a8
commit
7dbbb5422a
8 changed files with 28 additions and 22 deletions
|
@ -6,8 +6,7 @@ require Cwd;
|
||||||
use File::Basename qw/ dirname /;
|
use File::Basename qw/ dirname /;
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, $rel_name) = @_;
|
||||||
my $rel_name = shift;
|
|
||||||
my $self = bless {
|
my $self = bless {
|
||||||
rel_name => $rel_name,
|
rel_name => $rel_name,
|
||||||
name => Cwd::abs_path($rel_name),
|
name => Cwd::abs_path($rel_name),
|
||||||
|
|
|
@ -13,11 +13,11 @@ require Directory::Simplify::File;
|
||||||
# :squash-remove-end:
|
# :squash-remove-end:
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, %args) = @_;
|
||||||
return bless {
|
return bless {
|
||||||
_entries => {},
|
_entries => {},
|
||||||
_files_in_hash => {},
|
_files_in_hash => {},
|
||||||
@_,
|
%args,
|
||||||
}, $class;
|
}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -9,9 +9,9 @@ require Directory::Simplify::Utils;
|
||||||
# :squash-remove-end:
|
# :squash-remove-end:
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, %args) = @_;
|
||||||
return bless {
|
return bless {
|
||||||
@_,
|
%args,
|
||||||
}, $class;
|
}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -11,11 +11,11 @@ require Directory::Simplify::Instruction::Hardlink;
|
||||||
# :squash-remove-end:
|
# :squash-remove-end:
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, %args) = @_;
|
||||||
return bless {
|
return bless {
|
||||||
filehash => undef,
|
filehash => undef,
|
||||||
min_size => 1,
|
min_size => 1,
|
||||||
@_,
|
%args,
|
||||||
}, $class;
|
}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -9,10 +9,10 @@ require Directory::Simplify::Utils;
|
||||||
# :squash-remove-end:
|
# :squash-remove-end:
|
||||||
|
|
||||||
sub new {
|
sub new {
|
||||||
my $class = shift;
|
my ($class, %args) = @_;
|
||||||
return bless {
|
return bless {
|
||||||
freed => 0,
|
freed => 0,
|
||||||
@_,
|
%args,
|
||||||
}, $class;
|
}, $class;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -4,8 +4,9 @@ use strict;
|
||||||
use warnings;
|
use warnings;
|
||||||
|
|
||||||
sub addcommas {
|
sub addcommas {
|
||||||
|
my @numbers = @_;
|
||||||
my @added;
|
my @added;
|
||||||
foreach my $num (@_) {
|
foreach my $num (@numbers) {
|
||||||
# don't split anything after the decimal
|
# don't split anything after the decimal
|
||||||
my @parts = split /\./, $num;
|
my @parts = split /\./, $num;
|
||||||
while ($parts[0] =~ s/(\d)(\d{3}(?:\D|$))/$1,$2/) {
|
while ($parts[0] =~ s/(\d)(\d{3}(?:\D|$))/$1,$2/) {
|
||||||
|
@ -36,11 +37,12 @@ sub hr_size {
|
||||||
|
|
||||||
sub shell_quote {
|
sub shell_quote {
|
||||||
# shell-escape argument for inclusion in non-interpolated single quotes
|
# shell-escape argument for inclusion in non-interpolated single quotes
|
||||||
|
my @words = @_;
|
||||||
my @transformed = map {
|
my @transformed = map {
|
||||||
(my $out = $_)
|
(my $out = $_)
|
||||||
=~ s/'/'\\''/g;
|
=~ s/'/'\\''/g;
|
||||||
"'$out'";
|
"'$out'";
|
||||||
} @_;
|
} @words;
|
||||||
wantarray ? @transformed : $transformed[0];
|
wantarray ? @transformed : $transformed[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -30,7 +30,7 @@ our @EXPORT = qw/
|
||||||
use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplify_static_dir-main.pl';
|
use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplify_static_dir-main.pl';
|
||||||
|
|
||||||
sub are_hardlinked {
|
sub are_hardlinked {
|
||||||
my $starter = shift;
|
my ($starter, @files) = @_;
|
||||||
|
|
||||||
my $gen_ident = sub {
|
my $gen_ident = sub {
|
||||||
my ($dev, $ino) = stat $_[0];
|
my ($dev, $ino) = stat $_[0];
|
||||||
|
@ -38,7 +38,7 @@ sub are_hardlinked {
|
||||||
};
|
};
|
||||||
|
|
||||||
my $starter_ident = $gen_ident->($starter);
|
my $starter_ident = $gen_ident->($starter);
|
||||||
foreach my $file (@_) {
|
foreach my $file (@files) {
|
||||||
if ($gen_ident->($file) ne $starter_ident) {
|
if ($gen_ident->($file) ne $starter_ident) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -47,7 +47,8 @@ sub are_hardlinked {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub file_exists {
|
sub file_exists {
|
||||||
foreach my $file (@_) {
|
my @files = @_;
|
||||||
|
foreach my $file (@files) {
|
||||||
unless (-e $file) {
|
unless (-e $file) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -56,12 +57,13 @@ sub file_exists {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub filemtime {
|
sub filemtime {
|
||||||
(stat shift)[9];
|
my $file = shift;
|
||||||
|
return (stat $file)[9];
|
||||||
}
|
}
|
||||||
|
|
||||||
sub has_mtime {
|
sub has_mtime {
|
||||||
my $mtime = shift;
|
my ($mtime, @files) = @_;
|
||||||
foreach my $file (@_) {
|
foreach my $file (@files) {
|
||||||
if (filemtime($file) != $mtime) {
|
if (filemtime($file) != $mtime) {
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
@ -96,7 +98,8 @@ sub prep_tar {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub run_script_capture {
|
sub run_script_capture {
|
||||||
my @cmd =(SCRIPT, @_);
|
my @args = @_;
|
||||||
|
my @cmd = (SCRIPT, @args);
|
||||||
|
|
||||||
use IPC::Open3 qw/ open3 /;
|
use IPC::Open3 qw/ open3 /;
|
||||||
my $stderr = File::Temp->new(
|
my $stderr = File::Temp->new(
|
||||||
|
@ -123,8 +126,9 @@ sub run_script_capture {
|
||||||
}
|
}
|
||||||
|
|
||||||
sub run_script {
|
sub run_script {
|
||||||
print STDERR '+ ' . SCRIPT . " @_\n";
|
my @args = @_;
|
||||||
system SCRIPT, @_;
|
print STDERR '+ ' . SCRIPT . " @args\n";
|
||||||
|
return system SCRIPT, @args;
|
||||||
}
|
}
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|
|
@ -17,8 +17,9 @@ my (undef, $stdout, $stderr) = run_script_capture('-f', $test_dir);
|
||||||
ok "freed 1,048,576 bytes (1 MB)\n" eq $stderr, 'prints freed bytes with commas';
|
ok "freed 1,048,576 bytes (1 MB)\n" eq $stderr, 'prints freed bytes with commas';
|
||||||
|
|
||||||
sub put_file {
|
sub put_file {
|
||||||
|
my @files = @_;
|
||||||
my $bytes = 1048576; # 1 MB
|
my $bytes = 1048576; # 1 MB
|
||||||
foreach my $file (@_) {
|
foreach my $file (@files) {
|
||||||
open my $fh, '>', $file
|
open my $fh, '>', $file
|
||||||
or die "Failed to open file $file for writing: $!";
|
or die "Failed to open file $file for writing: $!";
|
||||||
for (my $bytes_written = 0; $bytes_written < $bytes; ++$bytes_written) {
|
for (my $bytes_written = 0; $bytes_written < $bytes; ++$bytes_written) {
|
||||||
|
|
Loading…
Reference in a new issue