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 4     4   93979 use strict;
  4         10  
  4         238  
3 4     4   28 use warnings;
  4         9  
  4         342  
4              
5             our $VERSION = '1.19'; # VERSION
6              
7 4     4   3837 use Compress::Zlib;
  4         360029  
  4         1280  
8 4     4   498 use Crypt::OpenPGP::Buffer;
  4         10  
  4         185  
9 4     4   464 use Crypt::OpenPGP::Constants qw( DEFAULT_COMPRESS );
  4         9  
  4         58  
10 4     4   463 use Crypt::OpenPGP::ErrorHandler;
  4         9  
  4         164  
11 4     4   24 use base qw( Crypt::OpenPGP::ErrorHandler );
  4         9  
  4         4724  
12              
13             our %ALG = ( 1 => 'ZIP', 2 => 'Zlib' );
14             our %ALG_BY_NAME = map { $ALG{$_} => $_ } keys %ALG;
15              
16             sub alg {
17 2 50   2 0 1329 return $_[0]->{__alg} if ref($_[0]);
18 0 0       0 $ALG{$_[1]} || $_[1];
19             }
20              
21             sub alg_id {
22 3 100   3 0 84 return $_[0]->{__alg_id} if ref($_[0]);
23 1 50       9 $ALG_BY_NAME{$_[1]} || $_[1];
24             }
25              
26             sub new {
27 6     6 1 264629 my $comp = bless { }, shift;
28 6         141 $comp->init(@_);
29             }
30              
31             sub init {
32 6     6 0 15 my $comp = shift;
33 6         27 my %param = @_;
34 6 100       33 if (my $data = $param{Data}) {
35 3   33     13 my $alg = $param{Alg} || DEFAULT_COMPRESS;
36 3   33     14 $alg = $ALG{$alg} || $alg;
37 3         20 $comp->{__alg} = $alg;
38 3         40 $comp->{__alg_id} = $ALG_BY_NAME{$alg};
39 3         9 my %args;
40 3 100       15 if ($comp->{__alg_id} == 1) {
41 2         10 %args = (-WindowBits => -13, -MemLevel => 8);
42             }
43 3         7 my($d, $status, $compressed);
44 3         19 ($d, $status) = deflateInit(\%args);
45 3 50       1587 return (ref $comp)->error("Zlib deflateInit error: $status")
46             unless $status == Compress::Zlib::Z_OK();
47             {
48 3         21 my($output, $out);
  3         8  
49 3         13 ($output, $status) = $d->deflate($data);
50 3 50       63 last unless $status == Compress::Zlib::Z_OK();
51 3         23 ($out, $status) = $d->flush();
52 3 50       276 last unless $status == Compress::Zlib::Z_OK();
53 3         24 $compressed = $output . $out;
54             }
55 3 50       10 return (ref $comp)->error("Zlib deflation error: $status")
56             unless defined $compressed;
57 3         148 $comp->{data} = $compressed;
58             }
59 6         35 $comp;
60             }
61              
62             sub parse {
63 3     3 1 11 my $class = shift;
64 3         9 my($buf) = @_;
65 3         15 my $comp = $class->new;
66 3         21 $comp->{__alg_id} = $buf->get_int8;
67 3         109 $comp->{__alg} = $ALG{ $comp->{__alg_id} };
68 3         44 $comp->{data} = $buf->get_bytes($buf->length - $buf->offset);
69 3         96 $comp;
70             }
71              
72             sub save {
73 1     1 1 3 my $comp = shift;
74 1         7 my $buf = Crypt::OpenPGP::Buffer->new;
75 1         18 $buf->put_int8($comp->{__alg_id});
76 1         19 $buf->put_bytes($comp->{data});
77 1         15 $buf->bytes;
78             }
79              
80             sub decompress {
81 5     5 1 16 my $comp = shift;
82 5         12 my %args;
83 5 100       26 if ($comp->{__alg_id} == 1) {
84 3         12 %args = (-WindowBits => -13);
85             }
86 5         11 my($i, $status, $out);
87 5         29 ($i, $status) = inflateInit(\%args);
88 5 50       1358 return $comp->error("Zlib inflateInit error: $status")
89             unless $status == Compress::Zlib::Z_OK();
90 5         48 ($out, $status) = $i->inflate($comp->{data});
91 5 50       283 return $comp->error("Zlib inflate error: $status")
92             unless defined $out;
93 5         70 $out;
94             }
95              
96             1;
97             __END__