--- 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__
--- 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"
--- 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) =
--- 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/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
- $ext = $o{compress} ? ".gz" : "";
+ my ($file, $ext, $cs);
+ $file = $cs = md5_hex($buffer);
+ $file =~ s/(?<fn>(?<prefix>...).*)/$+{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;