h3xx/simplify_static_dir
1
0
Fork 0
mirror of https://codeberg.org/h3xx/simplify_static_dir synced 2024-08-14 23:57:24 +00:00
Code Issues Projects Releases Packages Wiki Activity

Remove Perl 4 sigils (PBP)

Browse source
This commit is contained in:
Dan Church 2023-07-20 12:41:07 -05:00
parent 02f97c2a90
commit 907a7113a8
Signed by: h3xx
GPG key ID: EA2BF379CD2CDBD0
12 changed files with 56 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

2
lib/Directory/Simplify/FileHash.pm
View file

@ -43,7 +43,7 @@ sub add {
$self->{_entries}->{$hash} = []; $self->{_entries}->{$hash} = [];
} }
push @{$self->{_entries}->{$hash}}, $file; push @{$self->{_entries}->{$hash}}, $file;
&{$callback}($file) if ref $callback eq 'CODE'; $callback->($file) if ref $callback eq 'CODE';
} }
$self->{_files_in_hash}->{$file->{name}} = 1; $self->{_files_in_hash}->{$file->{name}} = 1;
} }

12
lib/Directory/Simplify/Instruction/Generator.pm
View file

@ -42,7 +42,7 @@ sub buckets {
next ELIMINATOR if $self->_entry_should_be_skipped($entry); next ELIMINATOR if $self->_entry_should_be_skipped($entry);
foreach my $bucket_idx (0 .. $#these_buckets) { foreach my $bucket_idx (0 .. $#these_buckets) {
if (&_entries_are_hard_linkable($these_buckets[$bucket_idx]->[0], $entry)) { if (_entries_are_hard_linkable($these_buckets[$bucket_idx]->[0], $entry)) {
push @{$these_buckets[$bucket_idx]}, $entry; push @{$these_buckets[$bucket_idx]}, $entry;
next ELIMINATOR; next ELIMINATOR;
} }
@ -71,16 +71,16 @@ sub _entries_are_hard_linkable {
my ($entry_a, $entry_b) = @_; my ($entry_a, $entry_b) = @_;
# obviously, if the sizes aren't the same, they're not the same file # obviously, if the sizes aren't the same, they're not the same file
unless (&_entries_sizes_match($entry_a, $entry_b)) { unless (_entries_sizes_match($entry_a, $entry_b)) {
return 0; return 0;
} }
# they're the same file, don't try it # they're the same file, don't try it
if (&_entries_are_already_hard_linked($entry_a, $entry_b)) { if (_entries_are_already_hard_linked($entry_a, $entry_b)) {
return 0; return 0;
} }
if (&_entries_contents_match($entry_a, $entry_b)) { if (_entries_contents_match($entry_a, $entry_b)) {
return 1; return 1;
} }
return 0; return 0;
@ -123,7 +123,7 @@ sub _entries_sizes_match {
sub _entries_contents_match { sub _entries_contents_match {
my ($entry_a, $entry_b) = @_; my ($entry_a, $entry_b) = @_;
my $contents_same = (0 == &File::Compare::compare($entry_a->{name}, $entry_b->{name})); my $contents_same = (0 == File::Compare::compare($entry_a->{name}, $entry_b->{name}));
# warn about hash collision # warn about hash collision
unless ($contents_same) { unless ($contents_same) {
@ -168,7 +168,7 @@ sub instructions {
target => $entry, target => $entry,
); );
} }
if (&Scalar::Util::refaddr($most_linked_entry) != &Scalar::Util::refaddr($oldest_entry)) { if (Scalar::Util::refaddr($most_linked_entry) != Scalar::Util::refaddr($oldest_entry)) {
# most_linked_entry should get its timestamp updated # most_linked_entry should get its timestamp updated
push @inst, Directory::Simplify::Instruction::CopyTimestamp->new( push @inst, Directory::Simplify::Instruction::CopyTimestamp->new(
source => $oldest_entry, source => $oldest_entry,

10
simplify_static_dir-main.pl
View file

@ -117,15 +117,15 @@ require Directory::Simplify::Utils;
sub HELP_MESSAGE { sub HELP_MESSAGE {
my $fh = shift; my $fh = shift;
&pod2usage( pod2usage(
-verbose => 1, -verbose => 1,
-exitval => 0, -exitval => 0,
); );
} }
MAIN: { MAIN: {
&getopts('vfm:M:z', \ my %opts) getopts('vfm:M:z', \ my %opts)
|| &pod2usage( || pod2usage(
-exitval => 2, -exitval => 2,
-msg => "Try '$0 --help' for more information", -msg => "Try '$0 --help' for more information",
); );
@ -145,7 +145,7 @@ MAIN: {
print STDERR 'Finding files...' print STDERR 'Finding files...'
if $verbose; if $verbose;
&find(sub { find(sub {
# outright skip directories (don't report skip) # outright skip directories (don't report skip)
return if -d $File::Find::name; return if -d $File::Find::name;
@ -214,7 +214,7 @@ MAIN: {
my $report_every = 1; # seconds my $report_every = 1; # seconds
my $processed_bytes = 0; my $processed_bytes = 0;
my $last_report = time; my $last_report = time;
my $total_size_hr = sprintf "%0.4G %s", Directory::Simplify::Utils::hr_size(&sum(map { $_->{size} } @files) or 0); my $total_size_hr = sprintf "%0.4G %s", Directory::Simplify::Utils::hr_size(sum(map { $_->{size} } @files) or 0);
my $cb; my $cb;
if ($print_progress) { if ($print_progress) {
printf STDERR "\e\x{37}"; printf STDERR "\e\x{37}";

10
t/TestFunctions.pm
View file

@ -37,9 +37,9 @@ sub are_hardlinked {
return "$dev:$ino"; return "$dev:$ino";
}; };
my $starter_ident = &$gen_ident($starter); my $starter_ident = $gen_ident->($starter);
foreach my $file (@_) { foreach my $file (@_) {
if (&$gen_ident($file) ne $starter_ident) { if ($gen_ident->($file) ne $starter_ident) {
return 0; return 0;
} }
} }
@ -62,7 +62,7 @@ sub filemtime {
sub has_mtime { sub has_mtime {
my $mtime = shift; my $mtime = shift;
foreach my $file (@_) { foreach my $file (@_) {
if (&filemtime($file) != $mtime) { if (filemtime($file) != $mtime) {
return 0; return 0;
} }
} }
@ -80,11 +80,11 @@ sub mktempdir {
sub prep_tar { sub prep_tar {
my $tarball = shift // (dirname(__FILE__) . '/t.tar'); my $tarball = shift // (dirname(__FILE__) . '/t.tar');
my $td = &mktempdir; my $td = mktempdir();
# Note: Using chdir from Cwd automatically keeps $ENV{PWD} up-to-date (just # Note: Using chdir from Cwd automatically keeps $ENV{PWD} up-to-date (just
# in case) # in case)
my $oldpwd = &getcwd; my $oldpwd = getcwd();
chdir $td; chdir $td;
my $tar = Archive::Tar->new; my $tar = Archive::Tar->new;

6
t/freed-bytes-commas.t
View file

@ -7,13 +7,13 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $test_dir = &mktempdir; my $test_dir = mktempdir();
&put_file( put_file(
"$test_dir/1", "$test_dir/1",
"$test_dir/2", "$test_dir/2",
); );
my (undef, $stdout, $stderr) = &run_script_capture('-f', $test_dir); 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 {

8
t/freed-bytes.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/freed-bytes"; my $test_dir = "$tarball_dir/t/freed-bytes";
my @files = ( my @files = (
"$test_dir/1", "$test_dir/1",
@ -17,7 +17,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
my (undef, $stdout, $stderr) = &run_script_capture('-f', $test_dir, $test_dir); my (undef, $stdout, $stderr) = run_script_capture('-f', $test_dir, $test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok "freed 24 bytes (24 B)\n" eq $stderr, 'prints correct number of freed bytes'; ok "freed 24 bytes (24 B)\n" eq $stderr, 'prints correct number of freed bytes';

10
t/link-counting.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/link-counting"; my $test_dir = "$tarball_dir/t/link-counting";
my @files = ( my @files = (
"$test_dir/most-links", "$test_dir/most-links",
@ -15,7 +15,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok &are_hardlinked(@files), 'files with existing links got hardlinked'; ok are_hardlinked(@files), 'files with existing links got hardlinked';

10
t/normal-linkage.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/normal"; my $test_dir = "$tarball_dir/t/normal";
my @files = ( my @files = (
"$test_dir/foo/same", "$test_dir/foo/same",
@ -15,7 +15,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok &are_hardlinked(@files), 'files with the same contents got hardlinked'; ok are_hardlinked(@files), 'files with the same contents got hardlinked';

10
t/normal-non-linkage.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/normal"; my $test_dir = "$tarball_dir/t/normal";
my @files = ( my @files = (
"$test_dir/foo/same", "$test_dir/foo/same",
@ -15,7 +15,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok !&are_hardlinked(@files), 'files with different contents did not get hardlinked'; ok !are_hardlinked(@files), 'files with different contents did not get hardlinked';

10
t/sha1collision-non-linkage.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/sha1-collision"; my $test_dir = "$tarball_dir/t/sha1-collision";
my @files = ( my @files = (
"$test_dir/shattered-1.pdf", "$test_dir/shattered-1.pdf",
@ -15,7 +15,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok !&are_hardlinked(@files), 'files with the same SHA-1 hash did not get hardlinked'; ok !are_hardlinked(@files), 'files with the same SHA-1 hash did not get hardlinked';

14
t/timestamp-preservation.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/timestamp-preservation"; my $test_dir = "$tarball_dir/t/timestamp-preservation";
my @files = ( my @files = (
"$test_dir/newer-more-linked", "$test_dir/newer-more-linked",
@ -15,9 +15,9 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
my $should_have_mtime = &filemtime($files[1]); my $should_have_mtime = filemtime($files[1]);
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok &are_hardlinked(@files); ok are_hardlinked(@files);
ok &has_mtime($should_have_mtime, @files), 'timestamps updated to use oldest'; ok has_mtime($should_have_mtime, @files), 'timestamps updated to use oldest';

10
t/zero-size-non-linkage.t
View file

@ -7,7 +7,7 @@ use Test::Simple
use TestFunctions; use TestFunctions;
my $tarball_dir = &prep_tar; my $tarball_dir = prep_tar();
my $test_dir = "$tarball_dir/t/zero-size"; my $test_dir = "$tarball_dir/t/zero-size";
my @files = ( my @files = (
"$test_dir/empty1", "$test_dir/empty1",
@ -15,7 +15,7 @@ my @files = (
); );
# Smoke test # Smoke test
ok !&are_hardlinked(@files), 'not hardlinked before we start'; ok !are_hardlinked(@files), 'not hardlinked before we start';
&run_script($test_dir); run_script($test_dir);
ok &file_exists(@files), 'files were not accidentally deleted'; ok file_exists(@files), 'files were not accidentally deleted';
ok !&are_hardlinked(@files), 'zero-sized files did not get hardlinked'; ok !are_hardlinked(@files), 'zero-sized files did not get hardlinked';