bin/imager.save
branchtesting
changeset 45 9362fac2a7c8
parent 44 f1fea4381014
child 46 8b655cc9bd27
equal deleted inserted replaced
44:f1fea4381014 45:9362fac2a7c8
    33     compress  => undef,
    33     compress  => undef,
    34     verbose   => undef,
    34     verbose   => undef,
    35     blocksize => BS,
    35     blocksize => BS,
    36     pass      => undef,
    36     pass      => undef,
    37     comment   => undef,
    37     comment   => undef,
       
    38     threads   => undef,
    38 );
    39 );
    39 lock_keys(%o);
    40 lock_keys(%o);
    40 
    41 
    41 my $NOW = time();
    42 my $NOW = time();
    42 
    43 
    48                 -verbose   => 2,
    49                 -verbose   => 2,
    49                 exit       => 0,
    50                 exit       => 0,
    50                 -noperldoc => system("perldoc -V >/dev/null 2>&1")
    51                 -noperldoc => system("perldoc -V >/dev/null 2>&1")
    51             );
    52             );
    52         },
    53         },
       
    54 	"t|threads:i"   => sub { $o{threads} = $_[1] ? $_[1] : 2 },
    53         "c|comment=s"   => \$o{comment},
    55         "c|comment=s"   => \$o{comment},
    54         "z|compress:i"  => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
    56         "z|compress:i"  => sub { $o{compress} = $_[1] ? $_[1] : Z_BEST_SPEED },
    55         "p|pass=s"      => \$o{pass},
    57         "p|pass=s"      => \$o{pass},
    56         "b|blocksize=s" => sub {
    58         "b|blocksize=s" => sub {
    57             given ($_[1]) {
    59             given ($_[1]) {
    99     $size = get_devsize($src);
   101     $size = get_devsize($src);
   100 
   102 
   101     -d $dst or die "$0: $dst: $!\n";
   103     -d $dst or die "$0: $dst: $!\n";
   102     mkpath([$data, $idx, $info]);
   104     mkpath([$data, $idx, $info]);
   103 
   105 
   104     my $index = File::Temp->new(DIR => $idx);
   106     my %index;
   105     print {$index} <<__EOT;
   107     $index{META} = {
   106 # imager
   108 	format => 1,
   107 format: 1
   109 	host => hostname,
   108 host: @{[hostname]}
   110 	filesystem => $src,
   109 filesystem: $src
   111 	blocksize => $o{blocksize},
   110 blocksize: $o{blocksize}
   112 	devsize => $size,
   111 devsize: $size
   113 	timestamp => NOW,
   112 timestamp: @{[NOW]}
   114 	datetime => DATETIME,
   113 datetime: @{[DATETIME]}
   115 	(defined $o{comment} ? (comment => $o{comment}) : ()),
   114 comment: @{[$o{comment}//"none"]}
   116 	encryption => $o{pass} ? CIPHER : "none",
   115 encryption: @{[$o{pass} ? CIPHER : "none"]}
   117     };
   116 
       
   117 __EOT
       
   118 
   118 
   119     open(my $in => $src);
   119     open(my $in => $src);
   120     binmode($in);
   120     binmode($in);
   121     local $/ = \$o{blocksize};
   121     local $/ = \$o{blocksize};
   122     local $| = 1;
   122     local $| = 1;
   149         $ext = "";
   149         $ext = "";
   150         $ext .= $o{compress} ? ".gz" : "";
   150         $ext .= $o{compress} ? ".gz" : "";
   151         $ext .= $o{pass}     ? ".x"  : "";
   151         $ext .= $o{pass}     ? ".x"  : "";
   152 
   152 
   153         # the extension we do not put into the index
   153         # the extension we do not put into the index
   154         my $log = sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   154 	push @{$index{BLOCKS}},
       
   155 	    sprintf "%12d %s %s" => ($. - 1), $cs, $file;
   155 
   156 
   156         if (
   157         if (
   157             not(   -e "$data/$file"
   158             not(   -e "$data/$file"
   158                 or -e "$data/$file.gz"
   159                 or -e "$data/$file.gz"
   159                 or -e "$data/$file.x"
   160                 or -e "$data/$file.x"
   180                 ) or die $GzipError;
   181                 ) or die $GzipError;
   181             }
   182             }
   182             else { print {$out} $buffer }
   183             else { print {$out} $buffer }
   183             close($out);
   184             close($out);
   184             rename($out => "$data/$file$ext");
   185             rename($out => "$data/$file$ext");
   185             $log .= " *";
   186 	    $index{BLOCKS}[$. - 1] .= " *";
   186             $stats{written}++;
   187             $stats{written}++;
   187         }
   188         }
   188         else {
   189         else {
   189             $log .= "  ";
       
   190             $stats{skipped}++;
   190             $stats{skipped}++;
   191         }
   191         }
   192 
       
   193         say {$index} $log;
       
   194     }
   192     }
   195     $SIG{ALRM}->();
   193     $SIG{ALRM}->();
   196     alarm 0;
   194     alarm 0;
   197 
   195 
   198     say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
   196     $index{META}{blocks} = @{$index{BLOCKS}};
       
   197     $index{META}{runtime} = time() - $^T . "s";
       
   198 
       
   199     my $index = File::Temp->new(DIR => $idx);
       
   200     say $index join "\n" =>
       
   201 	"# imager",
       
   202 	(map { "$_: $index{META}{$_}" } sort(keys %{$index{META}})),
       
   203 	"",
       
   204 	@{$index{BLOCKS}};
       
   205     close($index);
       
   206     rename $index->filename => "$idx/" . DATETIME;
   199 
   207 
   200     say "# $src DONE (runtime " . (time() - $^T) . "s)";
   208     say "# $src DONE (runtime " . (time() - $^T) . "s)";
   201     say "# $src WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
   209     say "# $src WRITTEN $stats{written}, SKIPPED $stats{skipped} blocks";
   202     say "# $src SAVINGS "
   210     say "# $src SAVINGS "
   203       . sprintf "%3d%%" => 100 *
   211       . sprintf "%3d%%" => 100 *
   204       ($stats{skipped} / ($stats{written} + $stats{skipped}));
   212       ($stats{skipped} / ($stats{written} + $stats{skipped}));
   205 
       
   206     rename $index->filename => "$idx/" . DATETIME;
       
   207     close $index;
       
   208 
   213 
   209 }
   214 }
   210 
   215 
   211 sub get_devsize {
   216 sub get_devsize {
   212     my ($devname) = @_;
   217     my ($devname) = @_;