Refactor 'more_linked'

- Make method static.
- Don't call dirname() in sort block. Relegate this to *::File.
  This carries with it a slight performance boost; calculate dirname of
  file only once upon instantiation, instead of (N log N) * 2 times.
- Move determination of read-only entries higher.
  This carries with it a slight performance boost as well, no longer
  redundantly testing directory write-ability N log N times (reduced to
  N times), and no longer requires memory to keep track of warnings
  issued.
This commit is contained in:
Dan Church 2023-07-20 13:29:55 -05:00
parent 5c6f506ed9
commit 02f97c2a90
Signed by: h3xx
GPG key ID: EA2BF379CD2CDBD0
2 changed files with 19 additions and 16 deletions

View file

@ -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};

View file

@ -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,