.editorconfig

@@ -12,8 +12,5 @@ indent_size = 4
 [*.md]
 indent_size = 2
 
-[.gitmodules]
-indent_style = tab
-
 [{Makefile,*.mak}]
 indent_style = tab

.gitmodules

@@ -1,4 +0,0 @@
-[submodule "perl-squasher"]
-	path = util/perl-squasher
-	url = https://codeberg.org/h3xx/perl-squasher.git
-	branch = main

CHANGELOG.md

@@ -14,11 +14,6 @@ All notable changes to this project will be documented in this file.
 - Omit output of progress bar unless -v flag is present
 - Add thousands separator commas to output
 
-### Fixed
-
-- Fixed issue where removable files wouldn't be linked with non-removable
-  files.
-
 ## [3.0.0]
 
 ### Changed

lib/Directory/Simplify/File.pm

@@ -1,20 +1,20 @@
 package Directory::Simplify::File;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 require Cwd;
-use File::Basename qw/ dirname /;
 
 sub new {
-    my ($class, $rel_name) = @_;
+    my $class = shift;
+    my $rel_name = shift;
     my $self = bless {
         rel_name => $rel_name,
         name => Cwd::abs_path($rel_name),
     }, $class;
-    $self->{dirname} = dirname($self->{name});
     (@{$self}{qw/ dev ino mode nlink uid gid rdev size
                 atime mtime ctime blksize blocks /})
         = lstat $self->{name};
-    return $self;
+    $self
 }
 
 sub hash {
@@ -25,7 +25,7 @@ sub hash {
         $ctx->addfile($self->{name});
         $self->{_hash} = $ctx->hexdigest;
     }
-    return $self->{_hash};
+    $self->{_hash}
 }
 
 1;

lib/Directory/Simplify/FileHash.pm

@@ -13,18 +13,25 @@ require Directory::Simplify::File;
 # :squash-remove-end:
 
 sub new {
-    my ($class, %args) = @_;
+    my $class = shift;
     return bless {
         _entries => {},
         _files_in_hash => {},
-        %args,
+        @_,
     }, $class;
 }
 
 sub add {
-    my ($self, %args) = @_;
+    my $self = shift;
-    my @files = @{$args{files}};
+    my (@files, $callback);
-    my $callback = $args{callback};
+    if (ref $_[0] eq 'HASH') {
+        # Called method like { files => [] }
+        my %opts = %{$_[0]};
+        @files = @{$opts{files}};
+        $callback = $opts{callback};
+    } else {
+        @files = @_;
+    }
     foreach my $file (@files) {
         unless (ref $file eq 'Directory::Simplify::File') {
             $file = Directory::Simplify::File->new($file);
@@ -36,18 +43,15 @@ sub add {
                 $self->{_entries}->{$hash} = [];
             }
             push @{$self->{_entries}->{$hash}}, $file;
-            if (ref $callback eq 'CODE') {
+            &{$callback}($file) if ref $callback eq 'CODE';
-                $callback->($file);
-            }
         }
         $self->{_files_in_hash}->{$file->{name}} = 1;
     }
-    return;
 }
 
 sub entries {
     my $self = shift;
-    return values %{$self->{_entries}};
+    values %{$self->{_entries}}
 }
 
 1;

lib/Directory/Simplify/Instruction/CopyTimestamp.pm

@@ -1,4 +1,5 @@
 package Directory::Simplify::Instruction::CopyTimestamp;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 use overload '""' => 'as_string';
@@ -8,9 +9,9 @@ require Directory::Simplify::Utils;
 # :squash-remove-end:
 
 sub new {
-    my ($class, %args) = @_;
+    my $class = shift;
     return bless {
-        %args,
+        @_,
     }, $class;
 }
 
@@ -18,7 +19,6 @@ sub run {
     my $self = shift;
     # preserve older time stamp
     utime $self->{source}->{atime}, $self->{source}->{mtime}, $self->{target}->{name};
-    return;
 }
 
 sub bytes_freed {

lib/Directory/Simplify/Instruction/Generator.pm

@@ -1,9 +1,10 @@
 package Directory::Simplify::Instruction::Generator;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 use overload '""' => 'as_string';
-use Carp qw/ carp /;
+use File::Basename qw/ dirname /;
-require File::Compare;
+use File::Compare qw/ compare /;
 
 # :squash-remove-start:
 require Directory::Simplify::Instruction::CopyTimestamp;
@@ -11,17 +12,17 @@ require Directory::Simplify::Instruction::Hardlink;
 # :squash-remove-end:
 
 sub new {
-    my ($class, %args) = @_;
+    my $class = shift;
     return bless {
         filehash => undef,
         min_size => 1,
-        %args,
+        @_,
     }, $class;
 }
 
 sub as_string {
     my $self = shift;
-    return join "\n", $self->instructions;
+    join "\n", $self->instructions;
 }
 
 sub buckets {
@@ -42,7 +43,7 @@ sub buckets {
                 next ELIMINATOR if $self->_entry_should_be_skipped($entry);
 
                 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;
                         next ELIMINATOR;
                     }
@@ -55,7 +56,7 @@ sub buckets {
         push @buckets, @these_buckets;
     }
 
-    return @buckets;
+    @buckets
 }
 
 sub _entry_should_be_skipped {
@@ -71,35 +72,41 @@ sub _entries_are_hard_linkable {
     my ($entry_a, $entry_b) = @_;
 
     # 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;
     }
 
     # 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;
     }
 
-    if (_entries_contents_match($entry_a, $entry_b)) {
+    if (&_entries_contents_match($entry_a, $entry_b)) {
         return 1;
     }
     return 0;
 }
 
-sub _oldest_mtime {
+sub oldest_mtime {
-    my @entries = @_;
+    my $self = shift;
-    my @sorted = sort {
+    return sort {
         $a->{mtime} <=> $b->{mtime}
-    } @entries;
+    } @_;
-    return @sorted;
 }
 
-sub _more_linked {
+sub more_linked {
-    my @entries = @_;
+    my $self = shift;
-    my @sorted = sort {
+    my %warned;
+    return sort {
+        if (! -w &dirname($a->{name})) {
+            warn "Warning: $a->{name} not able to be unlinked!" unless $warned{$a->{name}}++;
+            return 1; # favor a -> front
+        } elsif (! -w &dirname($b->{name})) {
+            warn "Warning: $b->{name} not able to be unlinked!" unless $warned{$b->{name}}++;
+            return -1; # favor b -> front
+        }
         $b->{nlink} <=> $a->{nlink}
-    } @entries;
+    } @_;
-    return @sorted;
 }
 
 sub _entries_are_already_hard_linked {
@@ -123,11 +130,11 @@ sub _entries_sizes_match {
 sub _entries_contents_match {
     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
     unless ($contents_same) {
-        carp "Hash collision between files:\n* $entry_a->{name}\n* $entry_b->{name}\n  (don't panic)\n";
+        warn "Hash collision between files:\n* $entry_a->{name}\n* $entry_b->{name}\n  (don't panic)\n";
     }
     return $contents_same;
 }
@@ -141,27 +148,12 @@ sub instructions {
     my @inst;
     foreach my $bucket ($self->buckets) {
 
-        # Of the bucket, find the oldest timestamp, regardless of read-only
+        # of the bucket, find the oldest timestamp
-        my ($oldest_entry) = _oldest_mtime(@{$bucket});
+        my ($oldest_entry) = $self->oldest_mtime(@{$bucket});
 
-        # Limit link/unlink operations to files in non-readonly directories
+        # of the bucket, find the file most embedded in the file system
-        my (@non_readonly, @readonly);
+        my @to_link = $self->more_linked(@{$bucket});
-        foreach my $entry (@{$bucket}) {
+        my $most_linked_entry = shift @to_link;
-            unless (-w $entry->{dirname}) {
-                carp "Warning: $entry->{name} not able to be unlinked!";
-                push @readonly, $entry;
-            } else {
-                push @non_readonly, $entry;
-            }
-        }
-
-        # Of the linkable files, find the file most embedded in the file system
-        my @to_link = _more_linked(@non_readonly);
-        @readonly = _more_linked(@readonly);
-
-        # Select a basis for linkage, either the most-linked readonly entry (if
-        # any) or the most linked of the read-write entries.
-        my $most_linked_entry = shift @readonly // shift @to_link;
         foreach my $entry (@to_link) {
             # XXX there shouldn't be a need to update entries' link counts,
             # since this generates all the instructions at once
@@ -174,7 +166,7 @@ sub instructions {
                 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
             push @inst, Directory::Simplify::Instruction::CopyTimestamp->new(
                 source => $oldest_entry,
@@ -182,7 +174,7 @@ sub instructions {
             );
         }
     }
-    return @inst;
+    @inst
 }
 
 1;

lib/Directory/Simplify/Instruction/Hardlink.pm

@@ -1,18 +1,18 @@
 package Directory::Simplify::Instruction::Hardlink;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 use overload '""' => 'as_string';
-use Carp qw/ croak /;
 
 # :squash-remove-start:
 require Directory::Simplify::Utils;
 # :squash-remove-end:
 
 sub new {
-    my ($class, %args) = @_;
+    my $class = shift;
     return bless {
         freed => 0,
-        %args,
+        @_,
     }, $class;
 }
 
@@ -21,17 +21,16 @@ sub run {
     # hard link the files
 
     unless (unlink $self->{target}->{name}) {
-        croak "Failed to remove file `$self->{target}->{name}': $!\n";
+        die "Failed to remove file `$self->{target}->{name}': $!\n";
     }
     unless (link $self->{source}->{name}, $self->{target}->{name}) {
-        croak "Failed to hard link `$self->{source}->{name}' => `$self->{target}->{name}': $!";
+        die "Failed to hard link `$self->{source}->{name}' => `$self->{target}->{name}': $!";
     }
     # bookkeeping
     ++$self->{source}->{nlink};
     if (--$self->{target}->{nlink} == 0) {
         $self->{freed} = $self->{target}->{size};
     }
-    return;
 }
 
 sub bytes_freed {

lib/Directory/Simplify/Utils.pm

@@ -1,18 +1,18 @@
 package Directory::Simplify::Utils;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
 sub addcommas {
-    my @numbers = @_;
     my @added;
-    foreach my $num (@numbers) {
+    foreach my $num (@_) {
         # don't split anything after the decimal
         my @parts = split /\./, $num;
         while ($parts[0] =~ s/(\d)(\d{3}(?:\D|$))/$1,$2/) {
         }
         push @added, (join '.', @parts);
     }
-    return wantarray ? @added : $added[0];
+    wantarray ? @added : $added[0]
 }
 
 sub hr_size {
@@ -29,21 +29,19 @@ sub hr_size {
     }
 
     # default to ($sz, 'bytes')
-    unless (@ret) {
+    @ret = ($sz, $sizes[0]) unless @ret;
-        @ret = ($sz, $sizes[0]);
-    }
 
-    return wantarray ? @ret : "@ret";
+    wantarray ? @ret : "@ret"
 }
 
 sub shell_quote {
     # shell-escape argument for inclusion in non-interpolated single quotes
-    my @words = @_;
+    my @transformed = map {
-    foreach my $word (@words) {
+        (my $out = $_)
-        $word =~ s/'/'\\''/g;
+            =~ s/'/'\\''/g;
-        $word = "'$word'";
+        "'$out'";
-    }
+    } @_;
-    return wantarray ? @words : $words[0];
+    wantarray ? @transformed : $transformed[0];
 }
 
 1;

make-allinone.sh

@@ -1,11 +1,12 @@
 #!/bin/bash
+# vi: et sts=4 sw=4 ts=4
 WORKDIR=${0%/*}
 OUT=$WORKDIR/simplify_static_dir.pl
 
 echo "Outputting to $OUT" >&2
 
 shopt -s globstar
-"$WORKDIR/util/perl-squasher/squash" \
+"$WORKDIR/util/squash" \
     "$WORKDIR/simplify_static_dir-main.pl" \
     "$WORKDIR"/lib/**/*.pm \
     > "$OUT"

simplify_static_dir-main.pl

@@ -1,4 +1,5 @@
 #!/usr/bin/perl
+# vi: et sts=4 sw=4 ts=4
 
 package main;
 use strict;
@@ -116,16 +117,15 @@ require Directory::Simplify::Utils;
 
 sub HELP_MESSAGE {
     my $fh = shift;
-    pod2usage(
+    &pod2usage(
         -verbose => 1,
         -exitval => 0,
     );
-    return;
 }
 
 MAIN: {
-    getopts('vfm:M:z', \ my %opts)
+    &getopts('vfm:M:z', \ my %opts)
-        || pod2usage(
+        || &pod2usage(
             -exitval => 2,
             -msg => "Try '$0 --help' for more information",
         );
@@ -142,26 +142,24 @@ MAIN: {
     my @dirs_to_process = map { Cwd::abs_path($_) } (@ARGV ? @ARGV : ($ENV{PWD}));
 
     my @files;
-    if ($verbose) {
+    print STDERR 'Finding files...'
-        print STDERR 'Finding files...';
+        if $verbose;
-    }
 
-    find(sub {
+    &find(sub {
         # outright skip directories (don't report skip)
         return if -d $File::Find::name;
 
         # skip non-existent files and links
-        if (! -f $File::Find::name || -l $File::Find::name) {
+        unless (-f $File::Find::name && ! -l $File::Find::name) {
             return;
         }
 
         push @files, Directory::Simplify::File->new($File::Find::name);
     }, @dirs_to_process);
 
-    if ($verbose) {
+    printf STDERR "%d files found",
-        printf STDERR '%d files found',
+        scalar @files
-            scalar @files;
+        if $verbose;
-    }
 
     # Limit to or exclude file patterns specified by `-m' or `-M', respectively
     #
@@ -176,18 +174,20 @@ MAIN: {
     @files = grep {
         $_->{rel_name} =~ $files_match
     } @files;
-    if ($verbose && $file_ct_before_filter != scalar @files) {
+    if ($file_ct_before_filter != scalar @files) {
-        printf STDERR ' (%d files filtered by -m rule)',
+        printf STDERR " (%d files filtered by -m rule)",
-            $file_ct_before_filter - scalar @files;
+            $file_ct_before_filter - scalar @files
+            if $verbose;
     }
     if (length $files_exclude) {
         $file_ct_before_filter = scalar @files;
         @files = grep {
             not $_->{rel_name} =~ $files_exclude
         } @files;
-        if ($verbose && $file_ct_before_filter != scalar @files) {
+        if ($file_ct_before_filter != scalar @files) {
-            printf STDERR ' (%d files filtered by -M rule)',
+            printf STDERR " (%d files filtered by -M rule)",
-                $file_ct_before_filter - scalar @files;
+                $file_ct_before_filter - scalar @files
+                if $verbose;
         }
     }
 
@@ -195,31 +195,26 @@ MAIN: {
     # unique size. The reasoning being that file sizes do not match, there's no
     # possible way those two files can have the same contents.
     my %file_sizes;
-    foreach my $file (@files) {
+    ++$file_sizes{$_->{size}} foreach @files;
-        ++$file_sizes{$file->{size}};
-    }
     @files = grep {
         $file_sizes{$_->{size}} > 1
     } @files;
 
-    if ($verbose) {
+    printf STDERR " (%d candidates).\n",
-        printf STDERR " (%d candidates).\n",
+        scalar @files
-            scalar @files;
+        if $verbose;
-    }
 
     unless (@files) {
         printf STDERR "Nothing to do.\n";
         exit 0;
     }
 
-    if ($verbose) {
+    print STDERR "Generating hashes..." if $verbose;
-        print STDERR 'Generating hashes...';
-    }
     my $filehash = Directory::Simplify::FileHash->new;
     my $report_every = 1; # seconds
     my $processed_bytes = 0;
     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;
     if ($print_progress) {
         printf STDERR "\e\x{37}";
@@ -234,13 +229,12 @@ MAIN: {
             }
         };
     }
-    $filehash->add(
+    $filehash->add({
         files => \@files,
         callback => $cb,
-    );
+    });
-    if ($verbose) {
+    print STDERR "done.\n"
-        print STDERR "done.\n";
+        if $verbose;
-    }
 
     my $generator = Directory::Simplify::Instruction::Generator->new(
         filehash => $filehash,
@@ -250,17 +244,14 @@ MAIN: {
     my $freed_bytes = 0;
 
     foreach my $inst ($generator->instructions) {
-        if ($verbose) {
+        print STDERR $inst, "\n" if $verbose;
-            print STDERR $inst, "\n";
-        }
         $inst->run;
         $freed_bytes += $inst->bytes_freed;
     }
 
-    if ($print_freed or $verbose) {
+    printf STDERR "freed %s bytes (%0.4G %s)\n",
-        printf STDERR "freed %s bytes (%0.4G %s)\n",
+        Directory::Simplify::Utils::addcommas($freed_bytes),
-            Directory::Simplify::Utils::addcommas($freed_bytes),
+        Directory::Simplify::Utils::hr_size($freed_bytes)
-            Directory::Simplify::Utils::hr_size($freed_bytes);
+            if $print_freed or $verbose;
-    }
 }
 

t/TestFunctions.pm

@@ -1,4 +1,5 @@
 package TestFunctions;
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
@@ -12,18 +13,13 @@ use File::Basename qw/
     dirname
 /;
 require File::Temp;
-use IPC::Open3 qw/ open3 /;
-use Symbol qw/ gensym /;
 
 use Exporter;
-use parent 'Exporter';
+our @ISA = qw/ Exporter /;
-## no critic ( Modules::ProhibitAutomaticExportation )
-# This is a test function library, it's not production code...
 our @EXPORT = qw/
     are_hardlinked
     file_exists
     filemtime
-    gen_ident
     has_mtime
     mktempdir
     prep_tar
@@ -34,11 +30,16 @@ our @EXPORT = qw/
 use constant SCRIPT => $ENV{SCRIPT} // abs_path dirname(__FILE__) . '/../simplify_static_dir-main.pl';
 
 sub are_hardlinked {
-    my ($starter, @files) = @_;
+    my $starter = shift;
 
-    my $starter_ident = gen_ident($starter);
+    my $gen_ident = sub {
-    foreach my $file (@files) {
+        my ($dev, $ino) = stat $_[0];
-        if (gen_ident($file) ne $starter_ident) {
+        return "$dev:$ino";
+    };
+
+    my $starter_ident = &$gen_ident($starter);
+    foreach my $file (@_) {
+        if (&$gen_ident($file) ne $starter_ident) {
             return 0;
         }
     }
@@ -46,8 +47,7 @@ sub are_hardlinked {
 }
 
 sub file_exists {
-    my @files = @_;
+    foreach my $file (@_) {
-    foreach my $file (@files) {
         unless (-e $file) {
             return 0;
         }
@@ -56,20 +56,13 @@ sub file_exists {
 }
 
 sub filemtime {
-    my $file = shift;
+    (stat shift)[9];
-    return (stat $file)[9];
-}
-
-sub gen_ident {
-    my $file = shift;
-    my ($dev, $ino) = stat $file;
-    return "$dev:$ino";
 }
 
 sub has_mtime {
-    my ($mtime, @files) = @_;
+    my $mtime = shift;
-    foreach my $file (@files) {
+    foreach my $file (@_) {
-        if (filemtime($file) != $mtime) {
+        if (&filemtime($file) != $mtime) {
             return 0;
         }
     }
@@ -87,11 +80,11 @@ sub mktempdir {
 sub prep_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
     # in case)
-    my $oldpwd = getcwd();
+    my $oldpwd = &getcwd;
 
     chdir $td;
     my $tar = Archive::Tar->new;
@@ -103,30 +96,35 @@ sub prep_tar {
 }
 
 sub run_script_capture {
-    my @args = @_;
+    my @cmd =(SCRIPT, @_);
-    my @cmd = (SCRIPT, @args);
+
-    my $in = '';
+    use IPC::Open3 qw/ open3 /;
-    my $child_out = gensym();
+    my $stderr = File::Temp->new(
-    my $child_err = gensym();
+        TMPDIR => 1,
-    print STDERR "+ @cmd\n";
+        CLEANUP => 1,
-    my $pid = open3 $in, $child_out, $child_err, @cmd;
+    );
-    waitpid $pid, 0;
+    my $stdout = File::Temp->new(
-    foreach my $handle ($child_out, $child_err) {
+        TMPDIR => 1,
-        seek $handle, 0, 0;
+        CLEANUP => 1,
-    }
+    );
+    my $in = '';
+    local *CATCHOUT = $stdout;
+    local *CATCHERR = $stderr;
+    print STDERR "+ @cmd\n";
+    my $pid = open3 $in, '>&CATCHOUT', '>&CATCHERR', @cmd;
+    waitpid $pid, 0;
+    seek $_, 0, 0 for \*CATCHOUT, \*CATCHERR;
 
-    local $/;
     return (
         $?,
-        scalar <$child_out>, # slurp!
+        (join "\n", <CATCHOUT>),
-        scalar <$child_err>, # slurp!
+        (join "\n", <CATCHERR>)
     );
 }
 
 sub run_script {
-    my @args = @_;
+    print STDERR '+ ' . SCRIPT . " @_\n";
-    print STDERR '+ ' . SCRIPT . " @args\n";
+    system SCRIPT, @_;
-    return system SCRIPT, @args;
 }
 
 1;

t/freed-bytes-commas.t

@@ -1,31 +1,28 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
-use Carp qw/ croak /;
+    tests => 1;
 
 use TestFunctions;
 
-my $test_dir = mktempdir();
+my $test_dir = &mktempdir;
-put_file(
+&put_file(
     "$test_dir/1",
     "$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';
 
 sub put_file {
-    my @files = @_;
+    my $bytes = 1048576; # 1 MB
-    my $bytes = 1_048_576; # 1 MB
+    foreach my $file (@_) {
-    foreach my $file (@files) {
         open my $fh, '>', $file
-            or croak("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) {
             print $fh 'A';
         }
-        close $fh;
     }
-    return;
 }

t/freed-bytes.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/freed-bytes";
 my @files = (
     "$test_dir/1",
@@ -16,7 +17,7 @@ my @files = (
 );
 
 # 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';

t/link-counting.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/link-counting";
 my @files = (
     "$test_dir/most-links",
@@ -14,7 +15,7 @@ my @files = (
 );
 
 # 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';

t/normal-linkage.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/normal";
 my @files = (
     "$test_dir/foo/same",
@@ -14,7 +15,7 @@ my @files = (
 );
 
 # 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';

t/normal-non-linkage.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/normal";
 my @files = (
     "$test_dir/foo/same",
@@ -14,7 +15,7 @@ my @files = (
 );
 
 # 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';

t/sha1collision-non-linkage.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/sha1-collision";
 my @files = (
     "$test_dir/shattered-1.pdf",
@@ -14,7 +15,7 @@ my @files = (
 );
 
 # 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';

t/some-files-readonly.t

@@ -1,68 +0,0 @@
-#!perl
-use strict;
-use warnings;
-
-require Data::Dumper;
-use Test::More 'no_plan';
-
-use TestFunctions;
-
-my $test_dir = mktempdir();
-
-my %files = (
-    rw1 => "$test_dir/rw-dir/1",
-    rw2 => "$test_dir/rw-dir/2",
-    ro1 => "$test_dir/ro-dir/ro-file",
-);
-
-PREP: {
-    mkdir "$test_dir/ro-dir";
-    mkdir "$test_dir/rw-dir";
-
-    # Create two read-write links
-    put_file($files{rw1});
-    link $files{rw1}, $files{rw2};
-
-    # Create a new less-linked but read-only file with the same contents
-    put_file($files{ro1});
-
-    # Lastly, make the directory read-only
-    chmod 0555, "$test_dir/ro-dir";
-}
-
-my $ident_ro_before = gen_ident($files{ro1});
-my $ident_rw_before = gen_ident($files{rw1});
-
-my ($exit_code, $stdout, $stderr) = run_script_capture('-f', $test_dir);
-is $exit_code, 0, 'script should not fail';
-
-ok file_exists(values %files), 'files were not accidentally deleted';
-is $ident_ro_before, gen_ident($files{ro1}), 'read-only file should not have been re-linked';
-ok are_hardlinked(values %files), 'all files should become hard-linked ' . prettify_file_idents(values %files);
-
-isnt $ident_rw_before, gen_ident($files{rw1}), 'the read-write file should become hard-linked';
-
-sub put_file {
-    my @files = @_;
-    my $bytes = 1_048_576; # 1 MB
-    foreach my $file (@files) {
-        open my $fh, '>', $file
-            or croak("Failed to open file $file for writing: $!");
-        for (my $bytes_written = 0; $bytes_written < $bytes; ++$bytes_written) {
-            print $fh 'A';
-        }
-        close $fh;
-    }
-    return;
-}
-
-sub prettify_file_idents {
-    my @files = @_;
-    my $d = Data::Dumper->new([{
-        map { ($_, gen_ident($_)) } @files
-    }]);
-    $d->Indent(1);
-    $d->Sortkeys(1);
-    $d->Terse(1);
-    return $d->Dump;
-}

t/timestamp-preservation.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 4;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/timestamp-preservation";
 my @files = (
     "$test_dir/newer-more-linked",
@@ -14,9 +15,9 @@ my @files = (
 );
 
 # 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), 'files should be hardlinked';
+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';

t/zero-size-non-linkage.t

@@ -1,12 +1,13 @@
-#!perl
+# vi: et sts=4 sw=4 ts=4
 use strict;
 use warnings;
 
-use Test::More 'no_plan';
+use Test::Simple
+    tests => 3;
 
 use TestFunctions;
 
-my $tarball_dir = prep_tar();
+my $tarball_dir = &prep_tar;
 my $test_dir = "$tarball_dir/t/zero-size";
 my @files = (
     "$test_dir/empty1",
@@ -14,7 +15,7 @@ my @files = (
 );
 
 # 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';

util/perl-squasher

@@ -1 +0,0 @@
-Subproject commit 9d414ab346caed6035db5a0512d6c89912a8826c

util/squash

@@ -0,0 +1,92 @@
+#!/usr/bin/perl
+# vi: et sts=4 sw=4 ts=4
+
+# Squashes together the parts of the app into the single script.
+# (Adapted from the script that squashes App::Ack - see https://github.com/beyondgrep/ack3)
+use warnings;
+use strict;
+
+my $code;
+for my $arg (@ARGV) {
+    my $filename = $arg;
+    if ($arg =~ /::/) {
+        my $key = "$arg.pm";
+        $key =~ s{::}{/}g;
+        $filename = $INC{$key} or die "Can't find the file for $arg";
+    }
+
+    warn "Reading $filename\n";
+    open my $fh, '<', $filename or die "Can't open $filename: $!";
+    my $in_pod = 0;
+    my $in_section = '';
+    my $ignore_lines = 0;
+    my $empty_lines = 0;
+    while (<$fh>) {
+        if (/#.*:squash-ignore-start:$/) {
+            $in_section = 'ignore';
+            $ignore_lines = 1;
+        } elsif (/#.*:squash-ignore-end:$/) {
+            $in_section = '';
+            $ignore_lines = 1;
+        }
+        if ($ignore_lines > 0) {
+            $ignore_lines--;
+            next;
+        }
+
+        if ($in_section eq 'ignore') {
+            $empty_lines = 0 unless /^$/;
+            $code .= $_;
+            next;
+        }
+
+        # Remove repeated newlines between paragraphs
+        # (Provided of course we're not in an 'ignore' section)
+        if (/^$/) {
+            ++$empty_lines;
+            if ($empty_lines > 1) {
+                next;
+            }
+        } else {
+            $empty_lines = 0;
+        }
+
+        if (/#.*:squash-remove-start:$/) {
+            $in_section = 'remove';
+            next;
+        } elsif (/#.*:squash-remove-end:$/) {
+            $in_section = '';
+            next;
+        }
+        next if $in_section eq 'remove';
+        next if /#.*:squash-remove-line:$/;
+
+        next if /^\s*1;$/;
+
+        if ($filename =~ /\.pm$/) {
+            # See if we're in module POD blocks
+            if (/^=(\w+)/) {
+                $in_pod = ($1 ne 'cut');
+                next;
+            }
+            elsif ($in_pod) {
+                next;
+            }
+            next if /^# vi:/;
+        }
+
+        # Remove Perl::Critic comments.
+        # I'd like to remove all comments, but this is a start
+        s{\s*##.+critic.*}{};
+        $code .= $_;
+    }
+
+    # Warn if there were unterminated :squash-*: sections
+    warn "$filename: Unterminated :squash-$in_section-start: section" if $in_section;
+
+    close $fh;
+}
+
+print $code;
+
+exit 0;