factored out generic delta file reading/writing/checking code

converted pristine-bz2 to use it so far

diff --git a/Pristine/Tar.pm b/Pristine/Tar.pm
index cccdee326f7ea5e1454debf53c798d20461ff12e..fc9a2a6a4aa503c21af3f9d1e03d7b0e3fdfba47 100644 (file)
--- a/Pristine/Tar.pm
+++ b/Pristine/Tar.pm
@@ -7,6 +7,7 @@ use warnings;
 use strict;
 use File::Temp;
 use Getopt::Long;
+use IPC::Open2;
 use Exporter q{import};
 
 our @EXPORT = qw(error message debug vprint doit doit_redir tempdir dispatch

diff --git a/Pristine/Tar/Delta.pm b/Pristine/Tar/Delta.pm
new file mode 100644 (file)
index 0000000..584c433
--- /dev/null
+++ b/Pristine/Tar/Delta.pm
@@ -0,0 +1,126 @@
+#!/usr/bin/perl
+package Pristine::Tar::Delta;
+
+use Pristine::Tar;
+use warnings;
+use strict;
+use File::Basename;
+
+# See delta-format.txt for details about the contents of delta files.
+#
+# Some of the delta contents are treated as files. Things not listed here
+# are treated as fields with short values.
+our %delta_files=map { $_ => 1 } qw(manifest delta wrapper);
+
+# After the filename to create, this takes a hashref containing
+# the contents of the delta file to create.
+sub write {
+       my $deltafile=shift;
+       my $delta=shift;
+
+       my $tempdir=tempdir();
+
+       my $stdout=0;
+       if ($deltafile eq "-") {
+               $stdout=1;
+               $deltafile="$tempdir/tmpout";
+       }
+
+       foreach my $field (keys %$delta) {
+               if ($delta_files{$field}) {
+                       link($delta->{$field}, "$tempdir/$field") || die "link $tempdir/$field: $!";
+               }
+               else {
+                       open (my $out, ">", "$tempdir/$field") || die "$tempdir/$field: $!";
+                       print $out $delta->{$field}."\n";
+                       close $out;
+               }
+       }
+
+       doit("tar", "czf", $deltafile, "-C", $tempdir, keys %$delta);
+
+       if ($stdout) {
+               doit("cat", $deltafile);
+               unlink($deltafile);
+       }
+
+       return $delta;
+}
+
+# Returns a hashref of the contents of the delta.
+sub read {
+       my $deltafile=shift;
+       
+       my $tempdir=tempdir();
+
+       my $stdin=0;
+       if ($deltafile eq "-") {
+               $deltafile="$tempdir/tmpin";
+               open (my $out, ">", $deltafile) || die "$deltafile: $!";
+               while (<STDIN>) {
+                       print $out $_;
+               }
+               close $out;
+       }
+       doit("tar", "xf", File::Spec->rel2abs($deltafile), "-C", $tempdir);
+       unlink($deltafile) if $stdin;
+
+       my %delta;
+       foreach my $file (glob("$tempdir/*")) {
+               if (-f $file) {
+                       my $field=basename($file);
+                       if ($delta_files{$field}) {
+                               $delta{$field}=$file;
+                       }
+                       else {
+                               open (my $in, "<", $file) || die "$file: $!";
+                               {
+                                       local $/=undef;
+                                       $delta{$field}=<$in>;
+                               }
+                               chomp $delta{$field};
+                               close $in;
+                       }
+               }
+       }
+       # TODO read all files
+       
+       return \%delta;
+}
+
+# Checks the type and maxversion of a delta hashref.
+# Checks that the delta contains all specified fields.
+# Returns the hashref if it is ok.
+sub assert {
+       my $delta=shift;
+       my %params=@_;
+
+       if (defined $params{maxversion}) {
+               if (! exists $delta->{version}) {
+                       error "delta lacks version";
+               }
+               if ($delta->{version} > $params{maxversion}) {
+                       error "delta is version ".$delta->{version}.", newer than maximum supported version $params{maxversion}";
+               }
+       }
+       if (defined $params{type}) {
+               if (! exists $delta->{type}) {
+                       error "delta lacks type";
+               }
+               if ($delta->{type} ne $params{type}) {
+                       error "delta is for a ".$delta->{type}.", not a $params{type}";
+               }
+       }
+
+       if ($params{fields}) {
+               foreach my $key (@{$params{fields}}) {
+                       if (! exists $delta->{$key}) {
+                               error "delta lacks $key";
+                       }
+               }
+       }
+
+       return $delta;
+}
+
+1

diff --git a/pristine-bz2 b/pristine-bz2
index c368a3f3ccb1e677e0de1bef9a7278aa1e03fcb5..ed55fb6564e57c780faee0213e3c46774ec3d2f1 100755 (executable)
--- a/pristine-bz2
+++ b/pristine-bz2
@@ -83,9 +83,8 @@ Licensed under the GPL, version 2.
 use warnings;
 use strict;
 use Pristine::Tar;
-use Pristine::Delta;
+use Pristine::Tar::Delta;
 use File::Basename qw/basename/;
-use IPC::Open2;
 use IO::Handle;
 
 my @supported_bzip2_programs = qw(bzip2 pbzip2 zgz);
@@ -96,7 +95,7 @@ dispatch(
        commands => {
                usage => [\&usage],
                genbz2 => [\&genbz2, 2],
-               genbdelta => [\&gendelta, 2],
+               gendelta => [\&gendelta, 2],
        },
        options => {
                "t|try!" => \$try,
@@ -189,7 +188,9 @@ sub testvariant {
 }
 
 sub reproducebzip2 {
-       my ($wd, $orig) = (shift, shift);
+       my $orig=shift;
+
+       my $wd=tempdir();
        
        my $tmpin="$wd/test";
        doit_redir($orig, "$tmpin.bak", "bzip2", "-dc");
@@ -240,60 +241,24 @@ sub reproducebzip2 {
 }
 
 sub genbz2 {
-       my $delta=shift;
+       my $deltafile=shift;
        my $file=shift;
 
-       my $tempdir=tempdir();
+       my $delta=Pristine::Tar::Delta::read($deltafile);
+       Pristine::Tar::Delta::assert($delta, type => "bz2", maxversion => 2, 
+               fields => [qw{params program}]);
 
-       if ($delta eq "-") {
-               $delta="$tempdir/in";
-               open (OUT, ">", $delta) || die "$delta: $!";
-               while (<STDIN>) {
-                       print OUT $_;
-               }
-               close OUT;
+       my @params=split(' ', $delta->{params});
+       foreach my $param (@params) {
+               next if $param=~/^(-[1-9])$/;
+               next if $param eq '--old-bzip2';
+               die "paranoia check failed on params from delta (@params)";
        }
 
-       doit("tar", "xf", File::Spec->rel2abs($delta), "-C", $tempdir);
-       if (! -e "$tempdir/type") {
-               die "failed to genbz2 delta $delta\n";
-       }
-
-       open (IN, "$tempdir/version") || die "delta lacks version number ($!)";
-       my $version=<IN>;
-       if ($version >= 3) {
-               die "delta is version $version, not supported\n";
-       }
-       close IN;
-       if (open (IN, "$tempdir/type")) {
-               my $type=<IN>;
-               chomp $type;
-               if ($type ne "bz2") {
-                       die "delta is for a $type, not a bz2\n";
-               }
-               close IN;
-       }
-
-       open (IN, "$tempdir/params") || die "delta lacks params file ($!)";
-       my $params=<IN>;
-       chomp $params;
-       my @params=split(' ', $params);
-       while (@params) {
-               $_=shift @params;
-               next if /^(-[1-9])$/;
-               next if $_ eq '--old-bzip2';
-               die "paranoia check failed on params file from delta ($params)";
-       }
-       @params=split(' ', $params);
-       close IN;
-
-       open (IN, "$tempdir/program") || die "delta lacks program file ($!)";
-       my $program=<IN>;
-       chomp $program;
+       my $program=$delta->{program};
        if (! grep { $program eq $_ } @supported_bzip2_programs) {
-               die "paranoia check failed on program file from delta ($program)";
+               die "paranoia check failed on program from delta ($program)";
        }
-       close IN;
 
        if ($program eq 'zgz') {
                # unlike bzip2, zgz only uses sdio
@@ -307,37 +272,14 @@ sub genbz2 {
 
 sub gendelta {
        my $bzip2file=shift;
-       my $delta=shift;
-
-       my $tempdir=tempdir();
-
-       my $stdout=0;
-       if ($delta eq "-") {
-               $stdout=1;
-               $delta="$tempdir/out";
-       }
+       my $deltafile=shift;
 
-       my @files=qw(version type params program);
+       my ($program, @params) = reproducebzip2($bzip2file);
 
-       my ($program, @params)=
-               reproducebzip2($tempdir, $bzip2file);
-
-       open(OUT, ">", "$tempdir/version") || die "$!";
-       print OUT "2.0\n";
-       close OUT;
-       open(OUT, ">", "$tempdir/type") || die "$!";
-       print OUT "bz2\n";
-       close OUT;
-       open(OUT, ">", "$tempdir/params") || die "$!";
-       print OUT "@params\n";
-       close OUT;
-       open(OUT, ">", "$tempdir/program") || die "$!";
-       print OUT "$program\n";
-       close OUT;
-
-       doit("tar", "czf", $delta, "-C", $tempdir, @files);
-
-       if ($stdout) {
-               doit("cat", $delta);
-       }
+       Pristine::Tar::Delta::write($deltafile, {
+               version => '2.0',
+               type => 'bz2',
+               params => "@params",
+               program => $program,
+       });
 }

diff --git a/pristine-gz b/pristine-gz
index b73c0f8f25e17e63f62c202522e2f6d05c30ac11..0e98500d73478b279a5e976dd4e1c25407efb07a 100755 (executable)
--- a/pristine-gz
+++ b/pristine-gz
@@ -90,9 +90,8 @@ Licensed under the GPL, version 2.
 use warnings;
 use strict;
 use Pristine::Tar;
-use Pristine::Delta;
+use Pristine::Tar::Delta;
 use File::Basename qw/basename/;
-use IPC::Open2;
 
 dispatch(
        commands => {

diff --git a/pristine-tar b/pristine-tar
index 9c63ba0b3c523d3c1259982fe8a27539821bb3b8..a02070c0c59dc42ef6354b60298f3836902ba7d0 100755 (executable)
--- a/pristine-tar
+++ b/pristine-tar
@@ -166,7 +166,7 @@ Licensed under the GPL, version 2 or above.
 use warnings;
 use strict;
 use Pristine::Tar;
-use Pristine::Delta;
+use Pristine::Tar::Delta;
 use File::Path;
 use File::Basename;
 use Cwd qw{getcwd abs_path};