X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?a=blobdiff_plain;f=dm6;h=8b45f507058e652a4093d6c51fe8fb7c57ae0091;hb=b2ef2da7bbf765cff8910935cfbdedca3f7296cf;hp=c6f93d906e94025621b230a6baa07e83dda44a5f;hpb=5b34b57b3f1927f907fafbb70913b23fe6d36b12;p=dupemerge diff --git a/dm6 b/dm6 index c6f93d9..8b45f50 100755 --- a/dm6 +++ b/dm6 @@ -63,7 +63,7 @@ sub link_files { unlink($tmp_to) or warn "unlink: $tmp_to: $!"; # Try, possibly in vain, to clean up die "rename: $tmp_to -> $from: $saved_bang"; } - print STDERR "\b \b"; + print STDERR "\b"; } my $link_dir = shift @ARGV; @@ -81,14 +81,25 @@ sub slash_prefix { return ($prefix, $suffix); } +sub mkdir_p { + my ($dir) = @_; + return if -d $dir; + $dir =~ s:/+$::os; + my $parent; + ($parent = $dir) =~ s:[^/]+$::os; + if ($parent ne $dir) { + mkdir_p($parent); + print STDERR 'm'; + mkdir($dir) or die "mkdir: $dir: $!"; + } + die "mkdir: $dir: $!" unless -d $dir; +} + sub prepare_parents { my ($link_dir, $file) = @_; my ($prefix, $suffix) = slash_prefix($file); my $parent = "$link_dir/$prefix"; - print STDERR 'm'; - mkpath($parent, { verbose => 0 }); - print STDERR "\b"; - die "mkpath: $parent: $!" unless -d $parent; + mkdir_p($parent); return "$parent/$suffix"; } @@ -186,6 +197,15 @@ while () { warn "$file: $@" if $@; } +# Garbage collection +print STDERR "\nGarbage collection in '$link_dir'..."; +chdir($link_dir) || die "chdir: $link_dir: $!"; +print STDERR "\nRemoving files with link count < 3..."; +system("find digest inode -type f -links -3 -print0 | xargs -0 rm -f") and die "system: exit status $?"; +print STDERR "\nRemoving empty directories..."; +system("find digest inode -type d -empty -print0 | xargs -0r rmdir -p --ignore-fail-on-non-empty") and die "system: exit status $?"; +print STDERR "\nDone.\n"; + exit(0); __END__