--- /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
--- 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__
--- 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 (<STDIN>) {
- when (/^y(?:es)?$/i) { unlink @unused; last }
- when (/^v/) { say join "\n", @unused; next }
- default { last }
- }
- }
+ while (1) {
+ print "delete? [y/N/v]: ";
+ given (<STDIN>) {
+ 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 (<STDIN>) {
- when (/^y(?:es)?$/i) { unlink @invalid; last }
- when (/^v/i) { say join "\n" => @invalid; next }
- default { last }
- }
+ print "delete? [y/N/v] ";
+ given (<STDIN>) {
+ when (/^y(?:es)?$/i) { unlink @invalid; last }
+ when (/^v/i) { say join "\n" => @invalid; next }
+ default { last }
+ }
}
}
__END__
--- 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 /^$/;
- /^(?<k>\S+):\s+(?<v>.*?)\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 /^$/;
+ /^(?<k>\S+):\s+(?<v>.*?)\s*$/
+ and do { $meta{ $+{k} } = $+{v}; next; };
+ }
+ return %meta;
+ }
}
-
__END__
=head1 NAME
--- 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/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
- $ext = ".gz" if $o{compress};
+ my ($file, $ext, $cs);
+ $file = $cs = md5_hex($buffer);
+ $file =~ s/(?<fn>(?<prefix>...).*)/$+{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