File Coverage

blib/lib/IO/Uncompress/AnyInflate.pm
Criterion Covered Total %
statement 64 66 96.9
branch 8 10 80.0
condition n/a
subroutine 15 16 93.7
pod 2 6 33.3
total 89 98 90.8


line stmt bran cond sub pod time code
1             package IO::Uncompress::AnyInflate ;
2              
3             # for RFC1950, RFC1951 or RFC1952
4              
5 6     6   34928 use strict;
  6         14  
  6         270  
6 6     6   31 use warnings;
  6         27  
  6         433  
7 6     6   2139 use bytes;
  6         2096  
  6         34  
8              
9 6     6   2504 use IO::Compress::Base::Common 2.220 qw(:Parse);
  6         135  
  6         1002  
10              
11 6     6   2187 use IO::Uncompress::Adapter::Inflate 2.220 ();
  6         117  
  6         199  
12              
13              
14 6     6   2419 use IO::Uncompress::Base 2.220 ;
  6         121  
  6         388  
15 6     6   2696 use IO::Uncompress::Gunzip 2.220 ;
  6         112  
  6         306  
16 6     6   2937 use IO::Uncompress::Inflate 2.220 ;
  6         197  
  6         399  
17 6     6   37 use IO::Uncompress::RawInflate 2.220 ;
  6         109  
  6         269  
18 6     6   3634 use IO::Uncompress::Unzip 2.220 ;
  6         145  
  6         3886  
19              
20             require Exporter ;
21              
22             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
23              
24             $VERSION = '2.220';
25             $AnyInflateError = '';
26              
27             @ISA = qw(IO::Uncompress::Base Exporter);
28             @EXPORT_OK = qw( $AnyInflateError anyinflate ) ;
29             %EXPORT_TAGS = %IO::Uncompress::Base::DEFLATE_CONSTANTS if keys %IO::Uncompress::Base::DEFLATE_CONSTANTS;
30             $EXPORT_TAGS{all} = [ defined $EXPORT_TAGS{all} ? @{ $EXPORT_TAGS{all} } : (), @EXPORT_OK ] ;
31             Exporter::export_ok_tags('all');
32              
33             # TODO - allow the user to pick a set of the three formats to allow
34             # or just assume want to auto-detect any of the three formats.
35              
36             sub new
37             {
38 36     36 1 171972 my $class = shift ;
39 36         134 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError);
40 36         155 $obj->_create(undef, 0, @_);
41             }
42              
43             sub anyinflate
44             {
45 0     0 1 0 my $obj = IO::Compress::Base::Common::createSelfTiedObject(undef, \$AnyInflateError);
46 0         0 return $obj->_inf(@_) ;
47             }
48              
49             sub getExtraParams
50             {
51 36     36 0 290 return ( 'rawinflate' => [Parse_boolean, 0] ) ;
52             }
53              
54             sub ckParams
55             {
56 36     36 0 60 my $self = shift ;
57 36         56 my $got = shift ;
58              
59             # any always needs both crc32 and adler32
60 36         126 $got->setValue('crc32' => 1);
61 36         85 $got->setValue('adler32' => 1);
62              
63 36         96 return 1;
64             }
65              
66             sub mkUncomp
67             {
68 36     36 0 53 my $self = shift ;
69 36         57 my $got = shift ;
70              
71 36         179 my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();
72              
73 36 50       97 return $self->saveErrorString(undef, $errstr, $errno)
74             if ! defined $obj;
75              
76 36         232 *$self->{Uncomp} = $obj;
77              
78 36         103 my @possible = qw( Inflate Gunzip Unzip );
79 36 100       116 unshift @possible, 'RawInflate'
80             if $got->getValue('rawinflate');
81              
82 36         105 my $magic = $self->ckMagic( @possible );
83              
84 36 100       88 if ($magic) {
85 32 50       96 *$self->{Info} = $self->readHeader($magic)
86             or return undef ;
87              
88 32         187 return 1;
89             }
90              
91 4         8 return 0 ;
92             }
93              
94              
95              
96             sub ckMagic
97             {
98 36     36 0 55 my $self = shift;
99 36         96 my @names = @_ ;
100              
101 36         70 my $keep = ref $self ;
102 36         90 for my $class ( map { "IO::Uncompress::$_" } @names)
  140         346  
103             {
104 92         403 bless $self => $class;
105 92         335 my $magic = $self->ckMagic();
106              
107 92 100       240 if ($magic)
108             {
109             #bless $self => $class;
110 32         121 return $magic ;
111             }
112              
113 60         170 $self->pushBack(*$self->{HeaderPending}) ;
114 60         140 *$self->{HeaderPending} = '' ;
115             }
116              
117 4         11 bless $self => $keep;
118 4         8 return undef;
119             }
120              
121             1 ;
122              
123             __END__