X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?p=dupemerge;a=blobdiff_plain;f=dm6;h=a88c83e1d17ba04a21b04fcff8762b48301a66da;hp=b7a9cdf57f9beb1318bd2aab794e21ead1310362;hb=de7efbca76dfc8ca745d8dabc2f9a99d9af0e4b4;hpb=fd37519dbb05cea1e1f8d20fbc944f9380f71f70 diff --git a/dm6 b/dm6 index b7a9cdf..a88c83e 100755 --- a/dm6 +++ b/dm6 @@ -7,8 +7,9 @@ use File::Compare; use File::Path; use File::Temp; use File::stat; +use MIME::Base64; -# Copyright (C) 2010 Zygo Blaxell +# Copyright (C) 2010 Zygo Blaxell # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by @@ -39,6 +40,8 @@ sub usage { die < $tmp_to: $!"; + print STDERR "\bR"; unless (rename($tmp_to, $to)) { my $saved_bang = $!; + print STDERR "\bU"; unlink($tmp_to) or warn "unlink: $tmp_to: $!"; # Try, possibly in vain, to clean up die "rename: $tmp_to -> $from: $saved_bang"; } - print STDERR "\n"; + print STDERR "\b"; } my $link_dir = shift @ARGV; -(-d $link_dir) or usage; +usage unless $link_dir; + +my $prefix_length = 3; sub slash_prefix { my ($file) = @_; - my $prefix = substr($file, 0, 3); - my $suffix = substr($file, 3); + $file .= '_' x (length($file) + 1 - $prefix_length) if length($file) + 1 < $prefix_length; + my $prefix = substr($file, 0, $prefix_length); + my $suffix = substr($file, $prefix_length); $prefix =~ s:(.):$1/:osg; chop($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"; - mkpath($parent, { verbose => 1 }); - die "mkpath: $parent: $!" unless -d $parent; - return "$parent/$prefix/$suffix"; + mkdir_p($parent); + return "$parent/$suffix"; +} + +sub name_quad { + my ($int64) = @_; + my $packed = pack('Q>', $int64); + $packed =~ s/^\0+//os; + my $base64_packed = encode_base64($packed, ''); + $base64_packed =~ y:/:_:; + # Don't strip off the trailing padding since it makes the string + # so short we end up just putting it back on again. + # $base64_packed =~ s/=+$//os; + return $base64_packed; +} + +sub name_ino { + my ($ino) = @_; + return name_quad($ino) . 'I'; } # ext3 cannot handle more than 32000 links to a file. Leave some headroom. +# Arguably this should be configurable, but the losses are miniscule and +# the coding for option support is not. my $link_count_max = 31990; $/ = "\0"; @@ -93,6 +134,7 @@ while () { chomp $file; # Get file stat data + print STDERR '.'; my $st = lstat($file); die "lstat: $file: $!" unless $st; @@ -103,7 +145,8 @@ while () { next if ($st->nlink > $link_count_max); # Check link to inode - my $inode_link = prepare_parents("$link_dir/inode", $st->ino); + my $inode_link = prepare_parents($link_dir, name_ino($st->ino)); + print STDERR 'I'; my $inode_st = lstat($inode_link); my $update_links; if ($inode_st) { @@ -119,49 +162,71 @@ while () { } else { $update_links = 1; } + print STDERR "\b"; # If neither criteria for updating link is met, leave it as-is next unless $update_links; # Compute digest - print STDERR "digest($file) = "; + print STDERR 'd'; my $digest = digest($file); + print STDERR "\b"; # Base64 uses /, we prefer _ $digest =~ y:/:_:; - print STDERR "$digest\n"; - # Check link to digest - my $digest_link = prepare_parents("$link_dir/digest", $digest); + my $digest_link = prepare_parents($link_dir, "${digest}D"); + print STDERR 'D'; my $digest_st = lstat($digest_link); if ($digest_st) { my $digest_nlink = $digest_st->nlink; if ($digest_nlink > 31990) { - print STDERR "Removing '$digest_link' with $digest_nlink links\n"; + print STDERR 'u'; unlink($digest_link) or die "unlink: $digest_link: $!"; undef $digest_st; } } + print STDERR "\b"; + + # Which file are we keeping? + my $keep_ino; # If digest link exists, link it to file if ($digest_st) { - print STDERR "cmp '$digest_link' '$file' ..."; + print STDERR 'c'; die "NOT identical!" if compare($digest_link, $file); - print STDERR "\n"; + + # Old, replace input with old file + print STDERR '-'; link_files($digest_link, $file); + $keep_ino = $digest_st->ino; } else { + # New, add input to digest + print STDERR '+'; link_files($file, $digest_link); + $keep_ino = $st->ino; } # A link to the inode indicates we are done, so do it last - link_files($file, $inode_link); + $inode_link = prepare_parents($link_dir, name_ino($keep_ino)); + print STDERR ' '; + link_files($digest_link, $inode_link); } }; 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 . -type f -links -3 -print0 | xargs -0rt rm -f") and die "system: exit status $?"; +print STDERR "\nRemoving empty directories..."; +system("find . -type d -empty -print0 | xargs -0rt rmdir -p --ignore-fail-on-non-empty") and die "system: exit status $?"; +print STDERR "\nDone.\n"; + exit(0); __END__