← Back to branch summary

~ubuntu-branches/ubuntu/oneiric/pristine-tar/oneiric

« back to all changes in this revision

Viewing changes to Pristine/Tar/Delta.pm

  • Committer: Bazaar Package Importer
  • Author(s): Joey Hess
  • Date: 2010-08-19 16:36:25 UTC
  • Revision ID: james.westby@ubuntu.com-20100819163625-y78g4vegbjm1n7mw
Tags: 1.10
http://bugs.debian.org/498760
* pristine-gz gengz: Bugfix: Always remove uncompressed input file.
* Large refactoring and modularization. (Thanks Gabriel de Perthuis
  for inspiration for this.))
* Remove environment variables used by tar, gz, and bzip2, to avoid
  local environment settings possibly breaking things.
  Closes: #498760 (probably; thanks Ralph Lange for analysis)
* Lintian fixes.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Pristine/Tar/Delta.pm
 
1
#!/usr/bin/perl
 
2
# pristine-tar delta file library
 
3
# See delta-format.txt for details about the contents of delta files.
 
4
package Pristine::Tar::Delta;
 
5
 
 
6
use Pristine::Tar;
 
7
use warnings;
 
8
use strict;
 
9
 
 
10
# Checks if a field of a delta should be stored in the delta hash using
 
11
# a filename. (Normally the hash stores the whole field value, but
 
12
# using filenames makes sense for a few fields.)
 
13
my %delta_files=map { $_ => 1 } qw(manifest delta wrapper);
 
14
sub is_filename {
 
15
        my $field=shift;
 
16
        return $delta_files{$field};
 
17
}
 
18
 
 
19
sub handler {
 
20
        my $action=shift;
 
21
        my $type=shift;
 
22
        
 
23
        my $class="Pristine::Tar::Delta::$type";
 
24
        eval "use $class";
 
25
        if ($@) {
 
26
                error "unsupported delta file format $type";
 
27
        }
 
28
        $class->$action(@_);
 
29
}
 
30
 
 
31
# After the type of delta and the file to create (which can be "-"
 
32
# to send it to stdout), this takes a hashref containing the contents of
 
33
# the delta to write.
 
34
sub write {
 
35
        my $type=shift;
 
36
        my $deltafile=shift;
 
37
        my $delta=shift;
 
38
 
 
39
        my $tempdir=tempdir();
 
40
 
 
41
        my $stdout=0;
 
42
        if ($deltafile eq "-") {
 
43
                $stdout=1;
 
44
                $deltafile="$tempdir/tmpout";
 
45
        }
 
46
        
 
47
        handler('write', $type, $deltafile, $delta);
 
48
 
 
49
        if ($stdout) {
 
50
                doit("cat", $deltafile);
 
51
                unlink($deltafile);
 
52
        }
 
53
 
 
54
        return $delta;
 
55
}
 
56
 
 
57
# Returns a hashref of the contents of the delta.
 
58
sub read {
 
59
        my $type=shift;
 
60
        my $deltafile=shift;
 
61
        
 
62
        my $tempdir=tempdir();
 
63
 
 
64
        my $stdin=0;
 
65
        if ($deltafile eq "-") {
 
66
                $deltafile="$tempdir/tmpin";
 
67
                open (my $out, ">", $deltafile) || die "$deltafile: $!";
 
68
                while (<STDIN>) {
 
69
                        print $out $_;
 
70
                }
 
71
                close $out;
 
72
        }
 
73
 
 
74
        my $delta=handler('read', $type, $deltafile);
 
75
        
 
76
        unlink($deltafile) if $stdin;
 
77
 
 
78
        return $delta;
 
79
}
 
80
 
 
81
# Checks the type, maxversion, minversion of a delta hashref.
 
82
# Checks that the delta contains all specified fields.
 
83
# Returns the hashref if it is ok.
 
84
sub assert {
 
85
        my $delta=shift;
 
86
        my %params=@_;
 
87
 
 
88
        if (! exists $delta->{version}) {
 
89
                error "delta lacks version";
 
90
        }
 
91
        if (defined $params{maxversion}) {
 
92
                if ($delta->{version} > $params{maxversion}) {
 
93
                        error "delta is version ".$delta->{version}.", newer than maximum supported version $params{maxversion}";
 
94
                }
 
95
        }
 
96
        if (defined $params{minversion}) {
 
97
                if ($delta->{version} < $params{minversion}) {
 
98
                        error "delta is version ".$delta->{version}.", older than minimum supported version $params{minversion}";
 
99
                }
 
100
        }
 
101
 
 
102
        if (! exists $delta->{type}) {
 
103
                error "delta lacks type";
 
104
        }
 
105
        if (defined $params{type}) {
 
106
                if ($delta->{type} ne $params{type}) {
 
107
                        error "delta is for a ".$delta->{type}.", not a $params{type}";
 
108
                }
 
109
        }
 
110
 
 
111
        if ($params{fields}) {
 
112
                foreach my $key (@{$params{fields}}) {
 
113
                        if (! exists $delta->{$key}) {
 
114
                                error "delta lacks $key";
 
115
                        }
 
116
                }
 
117
        }
 
118
 
 
119
        return $delta;
 
120
}
 
121
 
 
122
1