diff --git a/lib/Directory/Simplify/File.pm b/lib/Directory/Simplify/File.pm index 6591751..d794097 100644 --- a/lib/Directory/Simplify/File.pm +++ b/lib/Directory/Simplify/File.pm @@ -3,6 +3,7 @@ package Directory::Simplify::File; use strict; use warnings; require Cwd; +use File::Basename qw/ dirname /; sub new { my $class = shift; @@ -11,6 +12,7 @@ sub new { 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}; diff --git a/lib/Directory/Simplify/Instruction/Generator.pm b/lib/Directory/Simplify/Instruction/Generator.pm index fdbd1d8..9fe7571 100644 --- a/lib/Directory/Simplify/Instruction/Generator.pm +++ b/lib/Directory/Simplify/Instruction/Generator.pm @@ -3,7 +3,6 @@ package Directory::Simplify::Instruction::Generator; use strict; use warnings; use overload '""' => 'as_string'; -use File::Basename qw/ dirname /; require File::Compare; # :squash-remove-start: @@ -95,19 +94,12 @@ sub _oldest_mtime { return @sorted; } -sub more_linked { - my $self = shift; - 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 - } +sub _more_linked { + my @entries = @_; + my @sorted = sort { $b->{nlink} <=> $a->{nlink} - } @_; + } @entries; + return @sorted; } sub _entries_are_already_hard_linked { @@ -149,11 +141,20 @@ sub instructions { my @inst; foreach my $bucket ($self->buckets) { - # of the bucket, find the oldest timestamp + # Of the bucket, find the oldest timestamp, regardless of read-only my ($oldest_entry) = _oldest_mtime(@{$bucket}); - # of the bucket, find the file most embedded in the file system - my @to_link = $self->more_linked(@{$bucket}); + # Limit link/unlink operations to files in non-readonly directories + my @non_readonly; + foreach my $entry (@{$bucket}) { + unless (-w $entry->{dirname}) { + warn "Warning: $entry->{name} not able to be unlinked!"; + } + push @non_readonly, $entry; + } + + # Of the linkable files, find the file most embedded in the file system + my @to_link = _more_linked(@non_readonly); my $most_linked_entry = shift @to_link; foreach my $entry (@to_link) { # XXX there shouldn't be a need to update entries' link counts,