File Coverage

blib/lib/Crypt/OpenPGP/Compressed.pm
Criterion Covered Total %
statement 71 72 98.6
branch 16 26 61.5
condition 2 6 33.3
subroutine 14 14 100.0
pod 4 7 57.1
total 107 125 85.6


line stmt bran cond sub pod time code
1             package Crypt::OpenPGP::Compressed;
2 2     2   16154 use strict;
  2         4  
  2         64  
3              
4 2     2   1375 use Compress::Zlib;
  2         122533  
  2         416  
5 2     2   365 use Crypt::OpenPGP::Buffer;
  2         4  
  2         74  
6 2     2   419 use Crypt::OpenPGP::Constants qw( DEFAULT_COMPRESS );
  2         5  
  2         12  
7 2     2   302 use Crypt::OpenPGP::ErrorHandler;
  2         3  
  2         44  
8 2     2   7 use base qw( Crypt::OpenPGP::ErrorHandler );
  2         2  
  2         201  
9              
10 2     2   10 use vars qw( %ALG %ALG_BY_NAME );
  2         2  
  2         1146  
11             %ALG = ( 1 => 'ZIP', 2 => 'Zlib' );
12             %ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
13              
14             sub alg {
15 2 50   2 0 1300 return $_[0]->{__alg} if ref($_[0]);
16 0 0       0 $ALG{$_[1]} || $_[1];
17             }
18              
19             sub alg_id {
20 3 100   3 0 19 return $_[0]->{__alg_id} if ref($_[0]);
21 1 50       6 $ALG_BY_NAME{$_[1]} || $_[1];
22             }
23              
24             sub new {
25 4     4 1 568 my $comp = bless { }, shift;
26 4         14 $comp->init(@_);
27             }
28              
29             sub init {
30 4     4 0 6 my $comp = shift;
31 4         14 my %param = @_;
32 4 100       14 if (my $data = $param{Data}) {
33 3   33     12 my $alg = $param{Alg} || DEFAULT_COMPRESS;
34 3   33     11 $alg = $ALG{$alg} || $alg;
35 3         17 $comp->{__alg} = $alg;
36 3         6 $comp->{__alg_id} = $ALG_BY_NAME{$alg};
37 3         6 my %args;
38 3 100       13 if ($comp->{__alg_id} == 1) {
39 2         14 %args = (-WindowBits => -13, -MemLevel => 8);
40             }
41 3         4 my($d, $status, $compressed);
42 3         16 ($d, $status) = deflateInit(\%args);
43 3 50       1088 return (ref $comp)->error("Zlib deflateInit error: $status")
44             unless $status == Compress::Zlib::Z_OK();
45             {
46 3         13 my($output, $out);
  3         4  
47 3         11 ($output, $status) = $d->deflate($data);
48 3 50       63 last unless $status == Compress::Zlib::Z_OK();
49 3         19 ($out, $status) = $d->flush();
50 3 50       218 last unless $status == Compress::Zlib::Z_OK();
51 3         21 $compressed = $output . $out;
52             }
53 3 50       8 return (ref $comp)->error("Zlib deflation error: $status")
54             unless defined $compressed;
55 3         73 $comp->{data} = $compressed;
56             }
57 4         21 $comp;
58             }
59              
60             sub parse {
61 1     1 1 3 my $class = shift;
62 1         2 my($buf) = @_;
63 1         5 my $comp = $class->new;
64 1         5 $comp->{__alg_id} = $buf->get_int8;
65 1         15 $comp->{__alg} = $ALG{ $comp->{__alg_id} };
66 1         4 $comp->{data} = $buf->get_bytes($buf->length - $buf->offset);
67 1         15 $comp;
68             }
69              
70             sub save {
71 1     1 1 2 my $comp = shift;
72 1         5 my $buf = Crypt::OpenPGP::Buffer->new;
73 1         11 $buf->put_int8($comp->{__alg_id});
74 1         11 $buf->put_bytes($comp->{data});
75 1         9 $buf->bytes;
76             }
77              
78             sub decompress {
79 3     3 1 7 my $comp = shift;
80 3         5 my %args;
81 3 100       13 if ($comp->{__alg_id} == 1) {
82 2         12 %args = (-WindowBits => -13);
83             }
84 3         4 my($i, $status, $out);
85 3         13 ($i, $status) = inflateInit(\%args);
86 3 50       413 return $comp->error("Zlib inflateInit error: $status")
87             unless $status == Compress::Zlib::Z_OK();
88 3         23 ($out, $status) = $i->inflate($comp->{data});
89 3 50       135 return $comp->error("Zlib inflate error: $status")
90             unless defined $out;
91 3         26 $out;
92             }
93              
94             1;
95             __END__
96              
97             =head1 NAME
98              
99             Crypt::OpenPGP::Compressed - Compressed data packets
100              
101             =head1 SYNOPSIS
102              
103             use Crypt::OpenPGP::Compressed;
104              
105             my $data = 'serialized openpgp packets';
106             my $cdata = Crypt::OpenPGP::Compressed->new( Data => $data );
107             my $serialized = $cdata->save;
108              
109             =head1 DESCRIPTION
110              
111             I<Crypt::OpenPGP::Compressed> implements compressed data packets,
112             providing both compression and decompression functionality, for all
113             supported compression algorithms (C<Zlib> and C<ZIP>). This class
114             uses I<Compress::Zlib> for all compression/decompression needs for
115             both algorithms: C<ZIP> is simply C<Zlib> with a different setting
116             for the I<WindowBits> parameter.
117              
118             Decompressing a compressed data packet should always yield a stream
119             of valid PGP packets (which you can then parse using
120             I<Crypt::OpenPGP::PacketFactory>). Similarly, when compressing a
121             packet the input data should be a stream of packets.
122              
123             =head1 USAGE
124              
125             =head2 Crypt::OpenPGP::Compressed->new( %arg )
126              
127             Creates a new compressed data packet object and returns that object.
128             If there are no arguments in I<%arg>, the object is created with an
129             empty compressed data container; this is used, for example, in
130             I<parse> (below), to create an empty packet which is then filled with
131             the data in the buffer.
132              
133             If you wish to initialize a non-empty object, I<%arg> can contain:
134              
135             =over 4
136              
137             =item * Data
138              
139             A block of octets that make up the data that you wish to compress.
140             As mentioned above, the data to compress should always be a stream
141             of valid PGP packets (saved using I<Crypt::OpenPGP::PacketFactory::save>).
142              
143             This argument is required (for a non-empty object).
144              
145             =item * Alg
146              
147             The name (or ID) of a supported PGP compression algorithm. Valid
148             names are C<Zlib> and C<ZIP>.
149              
150             This argument is optional; by default I<Crypt::OpenPGP::Compressed> will
151             use C<ZIP>.
152              
153             =back
154              
155             =head2 $cdata->save
156              
157             Returns the serialized compressed data packet, which consists of
158             a one-octet compression algorithm ID, followed by the compressed
159             data.
160              
161             =head2 Crypt::OpenPGP::Compressed->parse($buffer)
162              
163             Given I<$buffer>, a I<Crypt::OpenPGP::Buffer> object holding (or with
164             offset pointing to) a compressed data packet, returns a new
165             I<Crypt::OpenPGP::Compressed> object, initialized with the data from
166             the buffer.
167              
168             =head2 $cdata->decompress
169              
170             Decompresses the compressed data in the I<Crypt::OpenPGP::Compressed>
171             object I<$cdata> and returns the decompressed data.
172              
173             =head1 AUTHOR & COPYRIGHTS
174              
175             Please see the Crypt::OpenPGP manpage for author, copyright, and
176             license information.
177              
178             =cut