# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1311200410 -7200
# Node ID 910cff13054185379769dc80e5ba0ef4afa54068
# Parent  79eb9a0609afc2466b299795f8f256fdc03745c0
imager: short usage manual

diff -r 79eb9a0609af -r 910cff130541 imager
--- a/imager	Mon Jul 18 22:56:50 2011 +0200
+++ b/imager	Thu Jul 21 00:20:10 2011 +0200
@@ -11,10 +11,13 @@
 use File::Temp;
 use Sys::Hostname;
 use IO::Compress::Gzip qw(gzip $GzipError);
+use Getopt::Long;
+use Pod::Usage;
 
 use constant KiB => 1024;
 use constant MiB => 1024 * KiB;
 use constant GiB => 1024 * MiB;
+use constant BLOCKSIZE => 8 * MiB;
 
 sub get_devsize;
 sub get_devname;
@@ -23,85 +26,94 @@
 
 my $compress = 0;
 
-my $DEV = shift // die "Need device name\n";
-my $DIR = shift // die "Need destination (root) directory\n";
-my $BS = 8 * MiB;  # should be multiple of 4k (file system block size)
 my $NOW = time();
 my $DATETIME = strftime("%Y-%m-%dT%H:%M:%SZ" => gmtime($NOW));
-my $SIZE = get_devsize($DEV);
+
+MAIN: {
+    my ($dev, $dir);
+
+    my $idx = "{DIR}/idx/{HOSTNAME}/{DEVICE}/";
+    my $data = "{DIR}/data";
+    my $size;
 
-my $DATA = "$DIR/data";
-my $IDX = "$DIR/idx/{HOSTNAME}/{DEVICE}/";
-$IDX =~ s/{HOSTNAME}/hostname/e;
-$IDX =~ s/{DEVICE}/get_devname($DEV)/e;
-
+    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 == 2 or pod2usage;
+    ($dev, $dir) = @ARGV;
 
--d $DIR or die "$0: $DIR: $!\n";
-mkpath($DATA, $IDX);
-
-
-my $index = File::Temp->new(DIR => $IDX);
+    foreach ($idx, $data) {
+	s/{DIR}/$dir/g;
+	s/{HOSTNAME}/hostname/eg;
+	s/{DEVICE}/get_devname($dev)/eg;
+    }
+    $size = get_devsize($dev);
 
-print {$index} <<__EOT;
+    -d $dir or die "$0: $dir: $!\n";
+    mkpath($data, $idx);
+
+    my $index = File::Temp->new(DIR => $idx);
+    print {$index} <<__EOT;
+# imager
 format: 1
-filesystem: $DEV
-blocksize: $BS
-devsize: $SIZE
+filesystem: $dev
+blocksize: @{[BLOCKSIZE]}
+devsize: $size
 timestamp: $NOW
 datetime: $DATETIME
 
 __EOT
 
-
-open(my $dev => $DEV);
-local $/ = \$BS;
-local $| = 1;
+    open(my $in => $dev);
+    binmode($in);
+    local $/ = \(my $bs = BLOCKSIZE);
+    local $| = 1;
 
-my %stats = (
-    written => 0,
-    skipped => 0
-);
+    my %stats = (
+	written => 0,
+	skipped => 0
+    );
+
+    while (my $buffer = <$in>) {
+	my $cs = md5_hex($buffer);
+	(my $file = $cs) =~ s/(..)(..)(.*)/$1\/$2\/$3/g;
+	$file .= ".gz" if $compress;
+
+	my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
 
-while (my $data = <$dev>) {
-    my $cs = md5_hex($data);
-    #(my $file = $cs) =~ s/(........)(?=.)/$1\//g;
-    #(my $file = $cs) =~ s/(.)(..)(....)(........)(.*)/$1\/$2\/$3\/$4\/$5/g;
-    (my $file = $cs) =~ s/(..)(..)(.*)/$1\/$2\/$3/g;
-    #$file = dirname($file) . "/$cs";
-    $file .= ".gz" if $compress;
-
-    my $log = sprintf "%6d %s %s" => ($.-1), $cs, $file;
+	if (!-e "$data/$file") {
+	    mkpath dirname("$data/$file");
+	    open(my $out, ">$data/$file");
+	    binmode($out);
+	    if ($compress) { gzip \$buffer => $out or die $GzipError } 
+	    else { print {$out} $buffer }
+	    close($out);
+	    $log .= " *";
+	    $stats{written}++;
+	}
+	else { 
+	    $log .= "  "; 
+	    $stats{skipped}++;
+	}
 
-    if (!-e "$DATA/$file") {
-	mkpath dirname("$DATA/$file");
-	open(my $out, ">$DATA/$file");
-	if ($compress) { gzip \$data => $out or die $GzipError } 
-	else { print {$out} $data }
-	close($out);
-	$log .= " *";
-	$stats{written}++;
-    }
-    else { 
-	$log .= "  "; 
-	$stats{skipped}++;
+	say $log . sprintf "%3d%%" => 100 * ($. * BLOCKSIZE)/$size;
+	say {$index} $log;
     }
 
-    say $log . sprintf "%3d%%" => 100 * ($. * $BS)/$SIZE;
-    say {$index} $log;
+    say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
+
+    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}));
+
+    rename $index->filename => "$idx/$DATETIME";
+    close $index;
+
 }
 
-say {$index} "# DONE (runtime " . (time() - $^T) . "s)";
-
-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}));
-
-rename $index->filename => "$IDX/$DATETIME";
-close $index;
-
-#---
-#
 sub get_devsize {
     my ($devname) = @_;
     open(my $fh => $devname);
@@ -116,3 +128,23 @@
     s/\//_/g;
     return $_;
 }
+    
+__END__
+
+=head1 NAME
+
+    imager - create a block device snapshot
+
+=head1 SYNOPSIS
+
+    imager [options] {device} {destination}
+
+=head1 DESCRIPTION
+
+This tool creates a snapshot of a blockdevice.
+
+=head1 OPTIONS
+
+Currently there are no useful options.
+
+=cut