# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1311844358 -7200 # Node ID e0f19213f8b6432f3d453e3e066679ca3c7c46a2 # Parent 49ff641055a36938c655d94a2e5b7da4c44ae50a [perltidy] diff -r 49ff641055a3 -r e0f19213f8b6 bin/.perltidyrc --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/bin/.perltidyrc Thu Jul 28 11:12:38 2011 +0200 @@ -0,0 +1,2 @@ +--paren-tightness=2 +--square-bracket-tightness=2 diff -r 49ff641055a3 -r e0f19213f8b6 bin/catter --- a/bin/catter Thu Jul 28 10:03:15 2011 +0200 +++ b/bin/catter Thu Jul 28 11:12:38 2011 +0200 @@ -8,7 +8,6 @@ # cat DATA/$f || zcat DATA/$f.gz # done - use 5.010; use strict; use warnings; @@ -22,7 +21,7 @@ use constant KiB => 1024; use constant MiB => 1024 * KiB; use constant GiB => 1024 * MiB; -use constant ME => basename $0; +use constant ME => basename $0; sub find_data_dir; @@ -30,59 +29,67 @@ Getopt::Long::Configure(qw(Bundling)); GetOptions( - "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, - "m|man" => sub { pod2usage(-verbose => 2, -exit => 0, - -noperldoc => system("perldoc -V 1>/dev/null - 2>&1")) }, - ) and @ARGV == 2 or pod2usage; + "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, + "m|man" => sub { + pod2usage( + -verbose => 2, + -exit => 0, + -noperldoc => system( + "perldoc -V 1>/dev/null + 2>&1" + ) + ); + }, + ) + and @ARGV == 2 + or pod2usage; - my $idx = shift; - my $dst = shift; + my $idx = shift; + my $dst = shift; my $blocksize = undef; - my $data = find_data_dir($idx); + my $data = find_data_dir($idx); open(my $fh => $idx); { local $/ = ""; $_ = <$fh>; } - /^format:\s*1$/m or die ME.": expected index format 1\n"; - ($blocksize) = /^blocksize:\s*(\d+)/m or die ME.": no blocksize found\n"; - + /^format:\s*1$/m or die ME . ": expected index format 1\n"; + ($blocksize) = /^blocksize:\s*(\d+)/m or die ME . ": no blocksize found\n"; my $out; - if ($dst eq "-") { open($out => ">&STDOUT") } - else { open($out => ">", $dst) }; + if ($dst eq "-") { open($out => ">&STDOUT") } + else { open($out => ">", $dst) } while (<$fh>) { - next if /^#/; - my ($blk, $hash, $path) = split; - my ($in, $buffer); + next if /^#/; + my ($blk, $hash, $path) = split; + my ($in, $buffer); - if (-f "$data/$path") { - open($in => "$data/$path"); - binmode($in); - local $/ = \$blocksize; - $buffer = <$in>; - } - elsif (-f "$data/$path.gz") { - open($in => "$data/$path.gz"); - binmode($in); - gunzip($in => \$buffer) - or die $GunzipError; - } - else { - die ME.": Can't open $data/$path: $!\n"; - } - print {$out} $buffer; - close($in); + if (-f "$data/$path") { + open($in => "$data/$path"); + binmode($in); + local $/ = \$blocksize; + $buffer = <$in>; + } + elsif (-f "$data/$path.gz") { + open($in => "$data/$path.gz"); + binmode($in); + gunzip($in => \$buffer) + or die $GunzipError; + } + else { + die ME . ": Can't open $data/$path: $!\n"; + } + print {$out} $buffer; + close($in); } close($out); close($fh); } sub find_data_dir { - for (my $dir = shift; $dir ne "/"; $dir = abs_path("$dir/..")) { - return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; + for (my $dir = shift ; $dir ne "/" ; $dir = abs_path("$dir/..")) { + return "$dir/data" if -d "$dir/data" and -d "$dir/idx"; } - die ME.": no data directory found!\n"; + die ME . ": no data directory found!\n"; } __END__ diff -r 49ff641055a3 -r e0f19213f8b6 bin/checker --- a/bin/checker Thu Jul 28 10:03:15 2011 +0200 +++ b/bin/checker Thu Jul 28 11:12:38 2011 +0200 @@ -18,22 +18,32 @@ sub check_images; my %o = ( - yes => undef, + yes => undef, verbose => undef, - check => undef, -); lock_keys(%o); + check => undef, +); +lock_keys(%o); MAIN: { Getopt::Long::Configure qw(Bundling); GetOptions( - "y|yes!" => \$o{yes}, - "v|verbose!" => \$o{verbose}, - "c|check" => \$o{check}, - "h|help" => sub { pod2usage(-verbose => 1, -exit 0) }, - "m|man" => sub { pod2usage(-verbose => 2, -exit 0, - -noperldoc => system("perldoc -V 1>/dev/null - 2>&1"))}, - ) and @ARGV or pod2usage; + "y|yes!" => \$o{yes}, + "v|verbose!" => \$o{verbose}, + "c|check" => \$o{check}, + "h|help" => sub { pod2usage(-verbose => 1, -exit 0) }, + "m|man" => sub { + pod2usage( + -verbose => 2, + -exit 0, + -noperldoc => system( + "perldoc -V 1>/dev/null + 2>&1" + ) + ); + }, + ) + and @ARGV + or pod2usage; my $dir = shift; my $tmp = File::Temp->new; @@ -43,8 +53,10 @@ my %block = get_block_list($dir); verbose("# indexed: " - . scalar(@{$block{""}//[]}) . " images with " - . (grep !/^\.idx$/ => keys(%block))." blocks"); + . scalar(@{ $block{""} // [] }) + . " images with " + . (grep !/^\.idx$/ => keys(%block)) + . " blocks"); purge_unused($dir => %block); check_images($dir => %block); @@ -58,7 +70,7 @@ open(my $fh => $list); while (<$fh>) { - push @files, (split)[2]; + push @files, (split)[2]; } return grep /^[a-z\d.\/]+$/ => @files; } @@ -66,13 +78,16 @@ sub get_block_list { my $dir = shift; my %block; - find(sub { - (-f) or return; # we need to include the tmp files! - push @{$block{""}}, abs_path $_; - foreach my $f (get_file_list($_)) { - push @{$block{$f}} => $#{$block{""}}; - } - }, "$dir/idx"); + find( + sub { + (-f) or return; # we need to include the tmp files! + push @{ $block{""} }, abs_path $_; + foreach my $f (get_file_list($_)) { + push @{ $block{$f} } => $#{ $block{""} }; + } + }, + "$dir/idx" + ); return %block; } @@ -84,68 +99,73 @@ verbose("# pass 1 - estimating file count"); # calculate the number of files we expect - find(sub { - -d or return; - opendir(my $dh => $_); - map { $total++ if not $_ ~~ [qw<. ..>] and length > 8} readdir $dh; - closedir($dh); - }, "$dir/data"); - + find( + sub { + -d or return; + opendir(my $dh => $_); + map { $total++ if not $_ ~~ [qw<. ..>] and length > 8 } readdir $dh; + closedir($dh); + }, + "$dir/data" + ); # progress local $SIG{ALRM} = sub { - return alarm 1 if not $done; - my $speed = $done / (time - $^T + 1); - verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)", - 100 * ($done/$total), - scalar(localtime($^T + $speed * ($total - $done))), - length($total) => $done, - $total; - alarm 5; + return alarm 1 if not $done; + my $speed = $done / (time - $^T + 1); + verbose sprintf "# pass 1 done %5.1f%% | %25s (%*d of %d blocks)", + 100 * ($done / $total), + scalar(localtime($^T + $speed * ($total - $done))), + length($total) => $done, + $total; + alarm 5; }; $SIG{ALRM}->(); my @unused; - find(sub { - $done++ if -f; - (-f _) and ((-M _) > 0) or return; # don't process the fresh blocks + find( + sub { + $done++ if -f; + (-f _) and ((-M _) > 0) or return; # don't process the fresh blocks - # we don't need uncompressed files if an compressed version - # exists - unlink $_ and return if -f "$_.gz"; + # we don't need uncompressed files if an compressed version + # exists + unlink $_ and return if -f "$_.gz"; - # cut away the first part of the filename and - # some optional extension - (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/; - exists $block{$rn} and return; - push @unused, abs_path $File::Find::name; - return; + # cut away the first part of the filename and + # some optional extension + (my $rn = $File::Find::name) =~ s/^$dir\/data\/(.*?)(?:\..+)?$/$1/; + exists $block{$rn} and return; + push @unused, abs_path $File::Find::name; + return; - }, "$dir/data"); + }, + "$dir/data" + ); $SIG{ALRM}->(); alarm 0; return if not @unused; say sprintf "found %d (%.1f%%) unused files", - 0+@unused, - 100 * (@unused/$total); + 0 + @unused, + 100 * (@unused / $total); if ($o{yes}) { - verbose("# deleting ".@unused." files"); - unlink @unused; - return; + verbose("# deleting " . @unused . " files"); + unlink @unused; + return; } if (-t) { - while(1) { - print "delete? [y/N/v]: "; - given () { - when (/^y(?:es)?$/i) { unlink @unused; last } - when (/^v/) { say join "\n", @unused; next } - default { last } - } - } + while (1) { + print "delete? [y/N/v]: "; + given () { + when (/^y(?:es)?$/i) { unlink @unused; last } + when (/^v/) { say join "\n", @unused; next } + default { last } + } + } } } @@ -160,53 +180,54 @@ # progress local $SIG{ALRM} = sub { - return alarm 1 if not $done; - my $speed = $done / (time - $^T + 1); - verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)", - 100 * $done/$total, - scalar(localtime($^T + ($total - $done) * $speed)), - length($total) => $done, - $total; - alarm 5; + return alarm 1 if not $done; + my $speed = $done / (time - $^T + 1); + verbose sprintf "# pass 2 done %5.1f%% | %25s (%*d of %d blocks)", + 100 * $done / $total, + scalar(localtime($^T + ($total - $done) * $speed)), + length($total) => $done, + $total; + alarm 5; }; $SIG{ALRM}->(); my %invalid; foreach my $k (keys %block) { - my $i = $block{$k}; - next if $k eq ""; - ++$done; - - next if -f "$dir/data/$k" - or -f "$dir/data/$k.gz"; - say "missing $k @$i"; - @invalid{@$i} = (); + my $i = $block{$k}; + next if $k eq ""; + ++$done; + + next + if -f "$dir/data/$k" + or -f "$dir/data/$k.gz"; + say "missing $k @$i"; + @invalid{@$i} = (); } $SIG{ALRM}->(); alarm 0; # invalid now contains the numbers of the idx files beiing # invalid - my @invalid = sort @{$block{""}}[keys %invalid]; + my @invalid = sort @{ $block{""} }[keys %invalid]; return if not @invalid; say sprintf "found %d (%.1f%%) invalid images:", - 0+@invalid, - 100 * (@invalid/$total); + 0 + @invalid, + 100 * (@invalid / $total); if ($o{yes}) { - unlink @invalid; - return; + unlink @invalid; + return; } while (-t) { - print "delete? [y/N/v] "; - given () { - when (/^y(?:es)?$/i) { unlink @invalid; last } - when (/^v/i) { say join "\n" => @invalid; next } - default { last } - } + print "delete? [y/N/v] "; + given () { + when (/^y(?:es)?$/i) { unlink @invalid; last } + when (/^v/i) { say join "\n" => @invalid; next } + default { last } + } } } __END__ diff -r 49ff641055a3 -r e0f19213f8b6 bin/fuse-imager --- a/bin/fuse-imager Thu Jul 28 10:03:15 2011 +0200 +++ b/bin/fuse-imager Thu Jul 28 11:12:38 2011 +0200 @@ -15,10 +15,11 @@ use File::Basename; my %o = ( - debug => undef, + debug => undef, detach => 1, - tmp => undef, -); lock_keys %o; + tmp => undef, +); +lock_keys %o; use constant ME => basename $0; my ($DATA, $IDX); @@ -28,41 +29,49 @@ MAIN: { GetOptions( - "d|debug!" => \$o{debug}, - "detach!" => \$o{detach}, - "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP}// "/tmp" }, - "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, - "m|man" => sub { pod2usage(-verbose => 2, -exit => 0, - -noperlpod => system("perldoc -V 1>/dev/null 2>&1")) }, - ) and @ARGV == 2 or pod2usage; + "d|debug!" => \$o{debug}, + "detach!" => \$o{detach}, + "tmp:s" => sub { $o{tmp} = length $_[1] ? $_[1] : $ENV{TMP} // "/tmp" }, + "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, + "m|man" => sub { + pod2usage( + -verbose => 2, + -exit => 0, + -noperlpod => system("perldoc -V 1>/dev/null 2>&1") + ); + }, + ) + and @ARGV == 2 + or pod2usage; my ($src, $mp) = @ARGV; $DATA = "$src/data"; - $IDX = "$src/idx"; + $IDX = "$src/idx"; - die ME.": $DATA: $!" if not -d $DATA; - die ME.": $IDX: $!" if not -d $IDX; + die ME . ": $DATA: $!" if not -d $DATA; + die ME . ": $IDX: $!" if not -d $IDX; if (!$o{debug} and $o{detach}) { - fork() and exit; - $0 = "FUSE $src $mp"; - open(STDOUT => ">/dev/null"); - open(STDIN => "/dev/null"); + fork() and exit; + $0 = "FUSE $src $mp"; + open(STDOUT => ">/dev/null"); + open(STDIN => "/dev/null"); - setpgid($$ => $$); + setpgid($$ => $$); } tie_vars $o{tmp}; - Fuse::main(mountpoint => $mp, - debug => $o{debug} // 0, - getattr => \&getattr, - getdir => \&getdir, - open => \&openfile, - read => \&readbuffer, - write => \&writebuffer, - ); + Fuse::main( + mountpoint => $mp, + debug => $o{debug} // 0, + getattr => \&getattr, + getdir => \&getdir, + open => \&openfile, + read => \&readbuffer, + write => \&writebuffer, + ); exit; @@ -73,154 +82,161 @@ { my (%IMAGE, %DIRTY); -sub tie_vars { - return if not defined $_[0]; - my $file = -d $_[0] ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX")->filename : shift; - tie %DIRTY, "DB_File" => $file - or die "Can't tie to $file: $!\n"; -} - -sub getattr { - my $path = $IDX . shift; - return stat $path if -d $path; - my @attr = stat $path or return -(ENOENT); - my %meta = _get_meta($path); - $attr[7] = $meta{devsize}; - $attr[9] = $meta{timestamp}; - $attr[2] &= ~0222; # r/o - return @attr; -} - -sub getdir { - my $path = $IDX . shift; - opendir(my $dh, $path) or return 0; - return (readdir($dh), 0); -} + sub tie_vars { + return if not defined $_[0]; + my $file = + -d $_[0] + ? File::Temp->new(DIR => shift, TEMPLATE => "tmp.fuse.XXXXXX") + ->filename + : shift; + tie %DIRTY, "DB_File" => $file + or die "Can't tie to $file: $!\n"; + } -sub openfile { - my $path = $IDX . shift; - return 0 if exists $IMAGE{$path}; - $IMAGE{$path}{meta} = { _get_meta($path) }; - $IMAGE{$path}{blocklist} = {}; - - # skip the file header - open(my $fh => $path); - { local $/ = ""; scalar <$fh> } - - # should check for the format - # $IMAGE{$path}{meta}{format} + sub getattr { + my $path = $IDX . shift; + return stat $path if -d $path; + my @attr = stat $path or return -(ENOENT); + my %meta = _get_meta($path); + $attr[7] = $meta{devsize}; + $attr[9] = $meta{timestamp}; + $attr[2] &= ~0222; # r/o + return @attr; + } - # now read the block list - while (<$fh>) { - /^#/ and last; - my ($block, $cs, $file) = split; - $IMAGE{$path}{blocklist}{$block} = $file; - } - close $fh; - return 0; -} - -sub readbuffer { - my $path = $IDX . shift; - my ($size, $offset) = @_; - my $finfo = $IMAGE{$path} or die "File $path is not opened!"; - return "" if $offset >= $finfo->{meta}{devsize}; - - my $buffer = ""; - for (my $need = $size; $need > 0; $need = $size - length($buffer)) { - $buffer .= _readblock($finfo, $need, $offset + length($buffer)); + sub getdir { + my $path = $IDX . shift; + opendir(my $dh, $path) or return 0; + return (readdir($dh), 0); } - return $buffer; -} + sub openfile { + my $path = $IDX . shift; + return 0 if exists $IMAGE{$path}; + $IMAGE{$path}{meta} = { _get_meta($path) }; + $IMAGE{$path}{blocklist} = {}; -sub _readblock { - my ($finfo, $size, $offset) = @_; + # skip the file header + open(my $fh => $path); + { local $/ = ""; scalar <$fh> } + + # should check for the format + # $IMAGE{$path}{meta}{format} - my $block = int($offset / $finfo->{meta}{blocksize}); - my $blockoffset = $offset % $finfo->{meta}{blocksize}; + # now read the block list + while (<$fh>) { + /^#/ and last; + my ($block, $cs, $file) = split; + $IMAGE{$path}{blocklist}{$block} = $file; + } + close $fh; + return 0; + } - my $length = $finfo->{meta}{blocksize} - $blockoffset; - $length = $size if $size <= $length; + sub readbuffer { + my $path = $IDX . shift; + my ($size, $offset) = @_; + my $finfo = $IMAGE{$path} or die "File $path is not opened!"; + return "" if $offset >= $finfo->{meta}{devsize}; - if (exists $DIRTY{$finfo.$block}) { - return substr $DIRTY{$finfo.$block}, $blockoffset, $length; + my $buffer = ""; + for (my $need = $size ; $need > 0 ; $need = $size - length($buffer)) { + $buffer .= _readblock($finfo, $need, $offset + length($buffer)); + } + + return $buffer; } - my $fn = "$DATA/" . $finfo->{blocklist}{$block}; - if (-e $fn) { - open(my $fh => $fn); - binmode($fh); - seek($fh => $blockoffset, 0) or die "seek: $!"; - local $/ = \$length; - return scalar <$fh>; - } - elsif (-e "$fn.gz") { - open(my $fh => "$fn.gz"); - binmode($fh); - my $buffer; - gunzip($fh => \$buffer) - or die $GunzipError; - close($fh); - return substr($buffer, $blockoffset, $size); - } - - die "$fn: $!\n"; -} + sub _readblock { + my ($finfo, $size, $offset) = @_; + + my $block = int($offset / $finfo->{meta}{blocksize}); + my $blockoffset = $offset % $finfo->{meta}{blocksize}; + + my $length = $finfo->{meta}{blocksize} - $blockoffset; + $length = $size if $size <= $length; + + if (exists $DIRTY{ $finfo . $block }) { + return substr $DIRTY{ $finfo . $block }, $blockoffset, $length; + } -sub writebuffer { - my $path = $IDX . shift; - my ($buffer, $offset) = @_; - my $size = length($buffer); - my $finfo = $IMAGE{$path} or die "File $path is not opened!"; + my $fn = "$DATA/" . $finfo->{blocklist}{$block}; + if (-e $fn) { + open(my $fh => $fn); + binmode($fh); + seek($fh => $blockoffset, 0) or die "seek: $!"; + local $/ = \$length; + return scalar <$fh>; + } + elsif (-e "$fn.gz") { + open(my $fh => "$fn.gz"); + binmode($fh); + my $buffer; + gunzip($fh => \$buffer) + or die $GunzipError; + close($fh); + return substr($buffer, $blockoffset, $size); + } - for (my $written = 0; $written < $size;) { - # OPTIMIZE: we should not ask for writing more than the - # blocksize - my $n = _writeblock($finfo, substr($buffer, $written), $offset + $written) - or return $written; - $written += $n; - } - return $size; -} - -sub _writeblock { - my ($finfo, $buffer, $offset) = @_; - my $size = length($buffer); - - my $block = int($offset / $finfo->{meta}{blocksize}); - my $blockoffset = $offset % $finfo->{meta}{blocksize}; - - if (not exists $DIRTY{$finfo.$block}) { - $DIRTY{$finfo.$block} = _readblock( - $finfo, - $finfo->{meta}{blocksize}, - $block * $finfo->{meta}{blocksize}); + die "$fn: $!\n"; } - my $length = $finfo->{meta}{blocksize} - $blockoffset; - $length = $size if $size < $length; + sub writebuffer { + my $path = $IDX . shift; + my ($buffer, $offset) = @_; + my $size = length($buffer); + my $finfo = $IMAGE{$path} or die "File $path is not opened!"; + + for (my $written = 0 ; $written < $size ;) { - substr($DIRTY{$finfo.$block}, $blockoffset, $length) - = substr($buffer, 0, $length); + # OPTIMIZE: we should not ask for writing more than the + # blocksize + my $n = + _writeblock($finfo, substr($buffer, $written), $offset + $written) + or return $written; + $written += $n; + } + return $size; + } - return $length; -} + sub _writeblock { + my ($finfo, $buffer, $offset) = @_; + my $size = length($buffer); + + my $block = int($offset / $finfo->{meta}{blocksize}); + my $blockoffset = $offset % $finfo->{meta}{blocksize}; -sub _get_meta { - my $path = shift; - my %meta; - open(my $fh => $path); - while(<$fh>) { - last if /^$/; - /^(?\S+):\s+(?.*?)\s*$/ and do { $meta{$+{k}} = $+{v}; next; }; + if (not exists $DIRTY{ $finfo . $block }) { + $DIRTY{ $finfo . $block } = _readblock( + $finfo, + $finfo->{meta}{blocksize}, + $block * $finfo->{meta}{blocksize} + ); + } + + my $length = $finfo->{meta}{blocksize} - $blockoffset; + $length = $size if $size < $length; + + substr($DIRTY{ $finfo . $block }, $blockoffset, $length) = + substr($buffer, 0, $length); + + return $length; } - return %meta; -} + + sub _get_meta { + my $path = shift; + my %meta; + open(my $fh => $path); + while (<$fh>) { + last if /^$/; + /^(?\S+):\s+(?.*?)\s*$/ + and do { $meta{ $+{k} } = $+{v}; next; }; + } + return %meta; + } } - __END__ =head1 NAME diff -r 49ff641055a3 -r e0f19213f8b6 bin/imager --- a/bin/imager Thu Jul 28 10:03:15 2011 +0200 +++ b/bin/imager Thu Jul 28 11:12:38 2011 +0200 @@ -15,10 +15,10 @@ use Getopt::Long; use Pod::Usage; -use constant KiB => 1024; -use constant MiB => 1024 * KiB; -use constant GiB => 1024 * MiB; -use constant NOW => time(); +use constant KiB => 1024; +use constant MiB => 1024 * KiB; +use constant GiB => 1024 * MiB; +use constant NOW => time(); use constant DATETIME => strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime(NOW)); sub get_devsize; @@ -27,43 +27,51 @@ $SIG{INT} = sub { die "Got INT\n" }; my %o = ( - compress => undef, - verbose => undef, + compress => undef, + verbose => undef, blocksize => 4 * MiB, -); lock_keys(%o); +); +lock_keys(%o); my $NOW = time(); MAIN: { my ($src, $dst); - my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/"; + my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/"; my $data = "{DIR}/data"; my $size; GetOptions( - "h|help" => sub { pod2usage(-verbose => 1, exit => 0) }, - "m|man" => sub { pod2usage(-verbose => 2, exit => 0, - -noperldoc => system("perldoc -V >/dev/null 2>&1")) - }, - "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED }, - "b|blocksize=s" => sub { - given ($_[1]) { - when (/(\d+)G/i) { $o{blocksize} = $1 * GiB }; - when (/(\d+)M/i) { $o{blocksize} = $1 * MiB }; - when (/(\d+)K/i) { $o{blocksize} = $1 * KiB }; - when (/^(\d+)$/) { $o{blocksize} = $1 }; - default { die "Blocksize $_[1] is incorrect!\n" - }; - } - }, - ) and @ARGV == 2 or pod2usage; + "h|help" => sub { pod2usage(-verbose => 1, exit => 0) }, + "m|man" => sub { + pod2usage( + -verbose => 2, + exit => 0, + -noperldoc => system("perldoc -V >/dev/null 2>&1") + ); + }, + "z|compress:i" => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED }, + "b|blocksize=s" => sub { + given ($_[1]) { + when (/(\d+)G/i) { $o{blocksize} = $1 * GiB }; + when (/(\d+)M/i) { $o{blocksize} = $1 * MiB }; + when (/(\d+)K/i) { $o{blocksize} = $1 * KiB }; + when (/^(\d+)$/) { $o{blocksize} = $1 }; + default { + die "Blocksize $_[1] is incorrect!\n" + }; + } + }, + ) + and @ARGV == 2 + or pod2usage; ($src, $dst) = @ARGV; foreach ($idx, $data) { - s/{DIR}/$dst/g; - s/{HOSTNAME}/hostname/eg; - s/{DEVICE}/get_devname($src)/eg; + s/{DIR}/$dst/g; + s/{HOSTNAME}/hostname/eg; + s/{DEVICE}/get_devname($src)/eg; } $size = get_devsize($src); @@ -89,55 +97,60 @@ local $| = 1; my %stats = ( - written => 0, - skipped => 0, - todo => 1 + int($size / $o{blocksize}), + written => 0, + skipped => 0, + todo => 1 + int($size / $o{blocksize}), ); local $SIG{ALRM} = sub { - my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1); - say sprintf "# done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)", - 100 * (($stats{written}+$stats{skipped})/$stats{todo}), - ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""), - length($stats{todo}) => $stats{written} + $stats{skipped}, - length($stats{todo}) => $stats{written}, - length($stats{todo}) => $stats{skipped}; - alarm(5); + my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1); + say sprintf +"# done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)", + 100 * (($stats{written} + $stats{skipped}) / $stats{todo}), + ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""), + length($stats{todo}) => $stats{written} + $stats{skipped}, + length($stats{todo}) => $stats{written}, + length($stats{todo}) => $stats{skipped}; + alarm(5); }; $SIG{ALRM}->(); while (my $buffer = <$in>) { - my ($file, $ext, $cs); - $file = $cs = md5_hex($buffer); - $file =~ s/(?(?...).*)/$+{prefix}\/$+{fn}/g; - $ext = ".gz" if $o{compress}; + my ($file, $ext, $cs); + $file = $cs = md5_hex($buffer); + $file =~ s/(?(?...).*)/$+{prefix}\/$+{fn}/g; + $ext = ".gz" if $o{compress}; - # the extension we do not put into the index - my $log = sprintf "%12d %s %s" => ($.-1), $cs, $file; + # the extension we do not put into the index + my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file; - if (not (-e "$data/$file" or -e "$data/$file.gz")) { - mkpath dirname("$data/$file.gz"); - my $out = File::Temp->new(TEMPLATE => ".XXXXXXX", DIR => dirname("$data/$file")); - binmode($out); - if ($o{compress}) { - gzip(\$buffer => $out, - -Minimal => 1, - -Level => Z_BEST_SPEED, - -Strategy => Z_FILTERED) - or die $GzipError - } - else { print {$out} $buffer } - close($out); - rename($out => "$data/$file$ext"); - $log .= " *"; - $stats{written}++; - } - else { - $log .= " "; - $stats{skipped}++; - } + if (not(-e "$data/$file" or -e "$data/$file.gz")) { + mkpath dirname("$data/$file.gz"); + my $out = File::Temp->new( + TEMPLATE => ".XXXXXXX", + DIR => dirname("$data/$file") + ); + binmode($out); + if ($o{compress}) { + gzip( + \$buffer => $out, + -Minimal => 1, + -Level => Z_BEST_SPEED, + -Strategy => Z_FILTERED + ) or die $GzipError; + } + else { print {$out} $buffer } + close($out); + rename($out => "$data/$file$ext"); + $log .= " *"; + $stats{written}++; + } + else { + $log .= " "; + $stats{skipped}++; + } - say {$index} $log; + say {$index} $log; } $SIG{ALRM}->(); alarm 0; @@ -146,10 +159,11 @@ say "# DONE (runtime " . (time() - $^T) . "s)"; say "# WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks"; - say "# SAVINGS " - . sprintf "%3d%%" => 100 * ($stats{skipped}/($stats{written}+$stats{skipped})); + say "# SAVINGS " + . sprintf "%3d%%" => 100 * + ($stats{skipped} / ($stats{written} + $stats{skipped})); - rename $index->filename => "$idx/".DATETIME; + rename $index->filename => "$idx/" . DATETIME; close $index; } @@ -168,7 +182,7 @@ s/\//_/g; return $_; } - + __END__ =head1 NAME