--- a/bin/imager.check Wed Aug 17 09:33:59 2011 +0200
+++ b/bin/imager.check Wed Aug 17 12:10:20 2011 +0200
@@ -11,8 +11,7 @@
use File::Basename;
use autodie qw(:all);
use Cwd qw(abs_path);
-use IO::Compress::Gzip qw(&gzip $GzipError Z_BEST_SPEED);
-use IO::Uncompress::Gunzip qw(&gunzip $GunzipError);
+use Imager;
use Getopt::Long;
use constant CIPHER => "aes-128-cbc";
@@ -20,7 +19,7 @@
sub purge_unused;
sub check_images;
-my %o = (
+our %o = (
yes => undef,
verbose => 1,
checksum => undef,
@@ -226,26 +225,7 @@
next if not $o{checksum};
# checking the checksum
- my $buffer;
- given ($file) {
- when (/\.gz\.x$/) {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass $o{pass} -in $file|");
- local $/ = undef;
- gunzip($fh => \$buffer) or die $GunzipError;
- }
- when (/\.gz$/) { gunzip($file => \$buffer) or die $GunzipError }
- when (/\.x$/) {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass $o{pass} -in $file|");
- local $/ = undef;
- $buffer = <$fh>;
- }
- default { open(my $fh => $file); local $/ = undef; $buffer = <$fh> }
- }
-
+ Imager::get_block($file => \my $buffer);
next if md5_hex($buffer) eq basename($file, qw(.gz .x .gz.x));
say "wrong checksum for $file\n";
@invalid{@$i} = ();
--- a/bin/imager.fuse Wed Aug 17 09:33:59 2011 +0200
+++ b/bin/imager.fuse Wed Aug 17 12:10:20 2011 +0200
@@ -13,6 +13,7 @@
use File::Temp;
use DB_File;
use File::Basename;
+use Imager;
my %o = (
debug => undef,
@@ -217,54 +218,25 @@
if (not defined $cache{fn}
or ($cache{fn} ne $fn))
{
-
if (-e $fn) {
- open(my $fh => $fn);
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
+ Imager::get_block($fn => \$cache{data});
}
elsif (-e "$fn.gz") {
- open(my $fh => "$fn.gz");
- binmode($fh);
- gunzip($fh => \$cache{data})
- or die $GunzipError;
+ Imager::get_block("$fn.gz" => \$cache{data});
}
elsif (-e "$fn.x") {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass '$o{pass}' -in '$fn.x'|");
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
- close($fh);
+ Imager::get_block("$fn.x" => \$cache{data});
}
elsif (-e "$fn.gz.x") {
- open(
- my $fh =>
- "openssl @{[CIPHER]} -d -pass '$o{pass}' -in '$fn.gz.x'|"
- );
- binmode($fh);
- gunzip($fh => \$cache{data})
- or die $GunzipError;
- close($fh);
+ Imager::get_block("$fn.gz.x" => \$cache{data});
}
- elsif (-e "$fn.x.gz") {
- warn "$fn.x.gz is depreciated!\n";
- open(
- my $fh =>
- "zcat $fn.x.gz | openssl @{[CIPHER]} -d -pass '$o{pass}'|"
- );
- binmode($fh);
- local $/ = undef;
- $cache{data} = <$fh>;
- close($fh);
- }
+ else {
+ die "Can't get file for $fn";
+ }
$cache{fn} = $fn;
}
return substr($cache{data}, $blockoffset, $length);
- die "$fn: $!\n";
}
--- a/bin/imager.restore Wed Aug 17 09:33:59 2011 +0200
+++ b/bin/imager.restore Wed Aug 17 12:10:20 2011 +0200
@@ -17,7 +17,7 @@
use Pod::Usage;
use Getopt::Long;
use Hash::Util qw(lock_keys);
-use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use Imager;
use constant KiB => 1024;
use constant MiB => 1024 * KiB;
@@ -67,48 +67,19 @@
while (<$fh>) {
next if /^#/;
my ($blk, $hash, $path) = split;
- my ($in, $buffer);
-
- if (-f "$data/$path") {
- open($in => "$data/$path");
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
- }
+ my $buffer;
+ if (-f "$data/$path") { Imager::get_block("$data/$path" => \$buffer) }
elsif (-f "$data/$path.gz") {
- open($in => "$data/$path.gz");
- binmode($in);
- gunzip($in => \$buffer)
- or die $GunzipError;
+ Imager::get_block("$data/$path.gz" => \$buffer);
}
elsif (-f "$data/$path.x") {
- open($in,
- "openssl @{[CIPHER]} -d -pass $o{pass} -in '$data/$path.x'|");
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
+ Imager::get_block("$data/$path.x" => \$buffer);
}
elsif (-f "$data/$path.gz.x") {
- open($in,
- "openssl @{[CIPHER]} -d -pass $o{pass} -in $data/$path.gz.x|");
- binmode($in);
- gunzip($in => \$buffer)
- or die $GunzipError;
+ Imager::get_block("$data/$path.gz.x" => \$buffer);
}
- elsif (-f "$data/$path.x.gz") {
- warn "$data/$path.x.gz: depreciated!\n";
- open($in,
-"gzip -d -c $data/$path.x.gz | openssl @{[CIPHER]} -d -pass $o{pass}|"
- );
- binmode($in);
- local $/ = undef;
- $buffer = <$in>;
- }
- else {
- die ME . ": Can't open $data/$path: $!\n";
- }
+ else { die ME . ": Can't open $data/$path: $!\n" }
print {$out} $buffer;
- close($in);
}
close($out);
close($fh);
--- a/bin/imager.save Wed Aug 17 09:33:59 2011 +0200
+++ b/bin/imager.save Wed Aug 17 12:10:20 2011 +0200
@@ -134,7 +134,7 @@
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),
+ basename($name),
100 * (($stats{written} + $stats{skipped}) / $stats{todo}),
($speed ? (scalar localtime($^T + $stats{todo} / $speed)) : ""),
length($stats{todo}) => $stats{written} + $stats{skipped},
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/.perltidyrc Wed Aug 17 12:10:20 2011 +0200
@@ -0,0 +1,2 @@
+--paren-tightness=2
+--square-bracket-tightness=2
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Imager.pm Wed Aug 17 12:10:20 2011 +0200
@@ -0,0 +1,29 @@
+package Imager;
+use 5.010;
+use strict;
+use warnings;
+use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
+use autodie qw(:all);
+
+use constant CIPHER => "aes-128-cbc";
+
+sub get_block {
+ my ($file, $buffer) = @_;
+
+ given ($file) {
+ when (/\.gz\.x$/) {
+ open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|");
+ local $/ = undef;
+ gunzip($fh => $buffer) or die $GunzipError;
+ }
+ when (/\.gz$/) { gunzip($file => $buffer) or die $GunzipError }
+ when (/\.x$/) {
+ open(my $fh => "openssl @{[CIPHER]} -d -pass $::o{pass} -in $file|");
+ local $/ = undef;
+ $$buffer = <$fh>;
+ }
+ default { open(my $fh => $file); local $/ = undef; $$buffer = <$fh> }
+ }
+}
+
+1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/scratch/y.pl Wed Aug 17 12:10:20 2011 +0200
@@ -0,0 +1,80 @@
+#!/usr/bin/perl
+use 5.010;
+use strict;
+use warnings;
+use Crypt::CBC;
+use autodie qw(:all);
+use Benchmark qw(:all);
+use File::Temp;
+
+my $tmp = File::Temp->new();
+
+{
+ open(my $fh, "/dev/urandom");
+ local $/ = \(my $x = 1024 * 1024); # 1 MiB
+ for (1 .. 4) {
+ print {$tmp} scalar <$fh>;
+ }
+}
+
+sub getbyref {
+ my $ref = shift;
+ local $/ = undef;
+ seek($tmp, 0, 0);
+ $$ref = <$tmp>;
+}
+
+sub getbyval {
+ seek($tmp, 0, 0);
+ local $/ = undef;
+ return <$tmp>;
+}
+
+cmpthese(900 => {
+ byref => sub { my $x; getbyref(\$x); $_ = length($x) },
+ byval => sub { my $x = getbyval(); $_ = length($x) },
+ }
+);
+
+
+
+__END__
+
+
+
+cmpthese(30 => {
+ 'openssl' => sub { openssl($text) },
+ 'perlssl' => sub { perlssl($text) },
+ }
+);
+
+cmpthese(30 => {
+ 'gzip' => sub { bingzip($text) },
+ 'perlzip' => sub { perlzip($text) },
+ }
+);
+
+sub openssl {
+ open(my $out, "|openssl bf -pass env:X -out $tmp") or die;
+ print $out $_[0];
+ close $out;
+ die $? if $?;
+}
+
+sub perlssl {
+ open(my $out, ">$tmp");
+ print $out $cipher0->encrypt($_[0]);
+ close $out;
+}
+
+sub perlzip {
+ open(my $out, ">$tmp");
+ gzip($_[0] => $out);
+}
+
+sub bingzip {
+ open(my $out, "|gzip -1 >$tmp");
+ print $out $_[0];
+ close $out;
+ die $? if $?
+}
--- a/t/000-syntax.t Wed Aug 17 09:33:59 2011 +0200
+++ b/t/000-syntax.t Wed Aug 17 12:10:20 2011 +0200
@@ -6,11 +6,12 @@
use File::Find;
my @scripts;
-find(sub { /^\./ and return; push @scripts, $File::Find::name if -f and -x }, "blib");
+find(sub { /^\./ and return;
+ push @scripts, $File::Find::name if -f and (-x or /\.pm$/)}, "blib");
plan tests => scalar @scripts;
foreach (@scripts) {
- my $e = `perl -c $_ 2>&1`;
- ok(!$?, "syntax ok") or diag $e;
+ my $e = `perl -Mblib -c $_ 2>&1`;
+ ok(!$?, "syntax $_ ok") or diag $e;
}