# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1311947529 -7200 # Node ID bbdb8ea3079a86b3eccd6ed948df5db5044c24e9 # Parent 3c71ae4facca2d47e47d6264d55135e2c5e8911f t diff -r 3c71ae4facca -r bbdb8ea3079a bin/imager --- a/bin/imager Fri Jul 29 14:53:40 2011 +0200 +++ b/bin/imager Fri Jul 29 15:52:09 2011 +0200 @@ -8,13 +8,18 @@ Getopt::Long::Configure("require_order"); 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")) }, -) and $ARGV[0] ~~ [qw(save restore fuse check)] + "m|man" => sub { + pod2usage( + -verbose => 2, + -exit => 0, + -noperldoc => system("perldoc -V >/dev/null 2>&1") + ); + }, + ) + and $ARGV[0] ~~ [qw(save restore fuse check)] or pod2usage; -exec "$0." .shift() => @ARGV; - +exec "$0." . shift() => @ARGV; __END__ diff -r 3c71ae4facca -r bbdb8ea3079a bin/imager.check --- a/bin/imager.check Fri Jul 29 14:53:40 2011 +0200 +++ b/bin/imager.check Fri Jul 29 15:52:09 2011 +0200 @@ -33,8 +33,8 @@ "h|help" => sub { pod2usage(-verbose => 1, -exit => 0) }, "m|man" => sub { pod2usage( - -verbose => 2, - -exit => 0, + -verbose => 2, + -exit => 0, -noperldoc => system( "perldoc -V 1>/dev/null 2>&1" diff -r 3c71ae4facca -r bbdb8ea3079a bin/imager.fuse --- a/bin/imager.fuse Fri Jul 29 14:53:40 2011 +0200 +++ b/bin/imager.fuse Fri Jul 29 15:52:09 2011 +0200 @@ -27,11 +27,16 @@ my ($DATA, $IDX); sub tie_vars; -sub min { (sort {$a <=> $b} @_)[0] } -sub max { (sort {$a <=> $b} @_)[-1] } + +sub min { + (sort { $a <=> $b } @_)[0]; +} + +sub max { + (sort { $a <=> $b } @_)[-1]; +} my $debug = sub { print STDERR @_ }; - $debug = sub { }; - +$debug = sub { }; #$SIG{INT} = sub { warn "Got ^C or INT signal\n"; exit 1; }; @@ -79,7 +84,7 @@ open => \&openfile, read => \&readbuffer, write => \&writebuffer, - release => \&release, + release => \&release, ); exit; @@ -143,10 +148,10 @@ } sub release { - my $path = $IDX . shift; - return 0 if not exists $IMAGE{$path}; - $debug->("Currently we have " . keys(%DIRTY) . " dirty blocks\n"); - return 0; + my $path = $IDX . shift; + return 0 if not exists $IMAGE{$path}; + $debug->("Currently we have " . keys(%DIRTY) . " dirty blocks\n"); + return 0; } sub readbuffer { @@ -165,65 +170,69 @@ sub _readblock { my ($finfo, $size, $offset) = @_; - my ($block, $blockoffset, $length); + my ($block, $blockoffset, $length); - $debug->("<<< block offset:$offset size:$size\n"); - $debug->( " block @{[int($offset/BS)]} + @{[$offset % BS]}\n"); + $debug->("<<< block offset:$offset size:$size\n"); + $debug->(" block @{[int($offset/BS)]} + @{[$offset % BS]}\n"); - # first check if it's an dirty block - $block = int($offset / BS); + # first check if it's an dirty block + $block = int($offset / BS); if (exists $DIRTY{ $finfo . $block }) { - $blockoffset = $offset % BS; - $length = min(BS - $blockoffset, $size); + $blockoffset = $offset % BS; + $length = min(BS - $blockoffset, $size); - $debug->("+++ dirty offset:$block*@{[BS]} + $blockoffset size:$length\n"); + $debug->( + "+++ dirty offset:$block*@{[BS]} + $blockoffset size:$length\n" + ); return substr $DIRTY{ $finfo . $block }, $blockoffset, $length; } - - # if not dirty, we've to find it on disk + # if not dirty, we've to find it on disk - $block = int($offset / $finfo->{meta}{blocksize}); - $blockoffset = $offset % $finfo->{meta}{blocksize}; - $length = min($finfo->{meta}{blocksize} - $blockoffset, $size); + $block = int($offset / $finfo->{meta}{blocksize}); + $blockoffset = $offset % $finfo->{meta}{blocksize}; + $length = min($finfo->{meta}{blocksize} - $blockoffset, $size); - # find the max length we can satisfy w/o colliding - # with dirty blocks - for (my $l = BS; $l < $length; $l += BS) { - my $b = int(($offset + $l)/BS); - if ($DIRTY{$finfo . $b}) { - $length = $l; - last; - } - } + # find the max length we can satisfy w/o colliding + # with dirty blocks + for (my $l = BS ; $l < $length ; $l += BS) { + my $b = int(($offset + $l) / BS); + if ($DIRTY{ $finfo . $b }) { + $length = $l; + last; + } + } - $debug->("=== $length\n"); - $debug->("+++ disk offset:$block*$finfo->{meta}{blocksize} + $blockoffset size:$length\n"); + $debug->("=== $length\n"); + $debug->( +"+++ disk offset:$block*$finfo->{meta}{blocksize} + $blockoffset size:$length\n" + ); my $fn = "$DATA/" . $finfo->{blocklist}{$block}; - state %cache; - if (not defined $cache{fn} - or ($cache{fn} ne $fn)) { + state %cache; + if (not defined $cache{fn} + or ($cache{fn} ne $fn)) + { - if (-e $fn) { - open(my $fh => $fn); - binmode($fh); - local $/ = undef; - $cache{data} = <$fh>; - } - elsif (-e "$fn.gz") { - open(my $fh => "$fn.gz"); - binmode($fh); - gunzip($fh => \$cache{data}) - or die $GunzipError; - } - $cache{fn} = $fn; - } + if (-e $fn) { + open(my $fh => $fn); + binmode($fh); + local $/ = undef; + $cache{data} = <$fh>; + } + elsif (-e "$fn.gz") { + open(my $fh => "$fn.gz"); + binmode($fh); + gunzip($fh => \$cache{data}) + or die $GunzipError; + } + $cache{fn} = $fn; + } - return substr($cache{data}, $blockoffset, $size); - die "$fn: $!\n"; - + return substr($cache{data}, $blockoffset, $size); + die "$fn: $!\n"; + } sub writebuffer { @@ -246,20 +255,19 @@ sub _writeblock { my ($finfo, $buffer, $offset) = @_; - my ($block, $blockoffset, $length); + my ($block, $blockoffset, $length); my $size = length($buffer); - $block = int($offset / BS); - $blockoffset = $offset % BS; - $length = min(BS - $blockoffset, $size); + $block = int($offset / BS); + $blockoffset = $offset % BS; + $length = min(BS - $blockoffset, $size); - $debug->(">>> offset:$offset size:$length of $size\n"); - $debug->(" block @{[int($offset/BS)]} + @{[$offset % BS]}\n"); + $debug->(">>> offset:$offset size:$length of $size\n"); + $debug->(" block @{[int($offset/BS)]} + @{[$offset % BS]}\n"); if (not exists $DIRTY{ $finfo . $block }) { - $debug->("+++ missing $block+$blockoffset\n"); - $DIRTY{ $finfo . $block } = _readblock( - $finfo, BS, $block * BS); + $debug->("+++ missing $block+$blockoffset\n"); + $DIRTY{ $finfo . $block } = _readblock($finfo, BS, $block * BS); } substr($DIRTY{ $finfo . $block }, $blockoffset, $length) = diff -r 3c71ae4facca -r bbdb8ea3079a bin/imager.save --- a/bin/imager.save Fri Jul 29 14:53:40 2011 +0200 +++ b/bin/imager.save Fri Jul 29 15:52:09 2011 +0200 @@ -15,7 +15,6 @@ use Getopt::Long; use Pod::Usage; - use constant KiB => 1024; use constant MiB => 1024 * KiB; use constant GiB => 1024 * MiB; @@ -60,18 +59,19 @@ } }, ) - and @ARGV >= 2 or pod2usage; + and @ARGV >= 2 + or pod2usage; my $dst = pop @ARGV; foreach my $src (@ARGV) { - if (my $pid = fork()) { - next; - } - elsif (not defined $pid) { - die "Can't fork: $!\n" - } - save($src, $dst); - exit; + if (my $pid = fork()) { + next; + } + elsif (not defined $pid) { + die "Can't fork: $!\n"; + } + save($src, $dst); + exit; } do 1 while wait != -1; @@ -122,7 +122,8 @@ my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1); say sprintf "# %*s done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)", - (sort {$a<=>$b} map { length basename $_ } @ARGV)[-1] => basename($src), + (sort { $a <=> $b } map { length basename $_ } @ARGV)[-1] => + basename($src), 100 * (($stats{written} + $stats{skipped}) / $stats{todo}), ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""), length($stats{todo}) => $stats{written} + $stats{skipped}, @@ -133,10 +134,10 @@ $SIG{ALRM}->(); while (my $buffer = <$in>) { - my ($file, $ext, $cs); - $file = $cs = md5_hex($buffer); - $file =~ s/(?(?...).*)/$+{prefix}\/$+{fn}/g; - $ext = $o{compress} ? ".gz" : ""; + my ($file, $ext, $cs); + $file = $cs = md5_hex($buffer); + $file =~ s/(?(?...).*)/$+{prefix}\/$+{fn}/g; + $ext = $o{compress} ? ".gz" : ""; # the extension we do not put into the index my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;