bin/imager.save
changeset 35 bbdb8ea3079a
parent 32 02ef2d1b190a
child 37 cb50d6c57439
equal deleted inserted replaced
34:3c71ae4facca 35:bbdb8ea3079a
    12 use Sys::Hostname;
    12 use Sys::Hostname;
    13 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);
    13 use IO::Compress::Gzip qw(gzip $GzipError :level :strategy);
    14 use Hash::Util qw(lock_keys);
    14 use Hash::Util qw(lock_keys);
    15 use Getopt::Long;
    15 use Getopt::Long;
    16 use Pod::Usage;
    16 use Pod::Usage;
    17 
       
    18 
    17 
    19 use constant KiB      => 1024;
    18 use constant KiB      => 1024;
    20 use constant MiB      => 1024 * KiB;
    19 use constant MiB      => 1024 * KiB;
    21 use constant GiB      => 1024 * MiB;
    20 use constant GiB      => 1024 * MiB;
    22 use constant NOW      => time();
    21 use constant NOW      => time();
    58                     die "Blocksize $_[1] is incorrect!\n"
    57                     die "Blocksize $_[1] is incorrect!\n"
    59                 };
    58                 };
    60             }
    59             }
    61         },
    60         },
    62       )
    61       )
    63       and @ARGV >= 2 or pod2usage;
    62       and @ARGV >= 2
       
    63       or pod2usage;
    64 
    64 
    65     my $dst = pop @ARGV;
    65     my $dst = pop @ARGV;
    66     foreach my $src (@ARGV) {
    66     foreach my $src (@ARGV) {
    67 	if (my $pid = fork()) {
    67         if (my $pid = fork()) {
    68 	    next;
    68             next;
    69 	}
    69         }
    70 	elsif (not defined $pid) {
    70         elsif (not defined $pid) {
    71 	    die "Can't fork: $!\n"
    71             die "Can't fork: $!\n";
    72 	}
    72         }
    73 	save($src, $dst);
    73         save($src, $dst);
    74 	exit;
    74         exit;
    75     }
    75     }
    76 
    76 
    77     do 1 while wait != -1;
    77     do 1 while wait != -1;
    78 
    78 
    79 }
    79 }
   120 
   120 
   121     local $SIG{ALRM} = sub {
   121     local $SIG{ALRM} = sub {
   122         my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1);
   122         my $speed = ($stats{written} + $stats{skipped}) / (time - $^T + 1);
   123         say sprintf
   123         say sprintf
   124 "# %*s done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)",
   124 "# %*s done %5.1f%% | %24s (%*d of $stats{todo}, written %*d, skipped %*d)",
   125 	  (sort {$a<=>$b} map { length basename $_ } @ARGV)[-1] => basename($src),
   125           (sort { $a <=> $b } map { length basename $_ } @ARGV)[-1] =>
       
   126           basename($src),
   126           100 * (($stats{written} + $stats{skipped}) / $stats{todo}),
   127           100 * (($stats{written} + $stats{skipped}) / $stats{todo}),
   127           ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),
   128           ($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),
   128           length($stats{todo}) => $stats{written} + $stats{skipped},
   129           length($stats{todo}) => $stats{written} + $stats{skipped},
   129           length($stats{todo}) => $stats{written},
   130           length($stats{todo}) => $stats{written},
   130           length($stats{todo}) => $stats{skipped};
   131           length($stats{todo}) => $stats{skipped};
   131         alarm(5);
   132         alarm(5);
   132     };
   133     };
   133     $SIG{ALRM}->();
   134     $SIG{ALRM}->();
   134 
   135 
   135     while (my $buffer = <$in>) {
   136     while (my $buffer = <$in>) {
   136 	my ($file, $ext, $cs);
   137         my ($file, $ext, $cs);
   137 	$file = $cs = md5_hex($buffer);
   138         $file = $cs = md5_hex($buffer);
   138 	$file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
   139         $file =~ s/(?<fn>(?<prefix>...).*)/$+{prefix}\/$+{fn}/g;
   139 	$ext = $o{compress} ? ".gz" : "";
   140         $ext = $o{compress} ? ".gz" : "";
   140 
   141 
   141         # the extension we do not put into the index
   142         # the extension we do not put into the index
   142         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   143         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   143 
   144 
   144         if (not(-e "$data/$file" or -e "$data/$file.gz")) {
   145         if (not(-e "$data/$file" or -e "$data/$file.gz")) {