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   24346 use strict;
  6         8  
  6         172  
6 6     6   19 use warnings;
  6         19  
  6         251  
7 6     6   3352 use bytes;
  6         1414  
  6         28  
8              
9 6     6   2064 use IO::Compress::Base::Common 2.223 qw(:Parse);
  6         114  
  6         792  
10              
11 6     6   1564 use IO::Uncompress::Adapter::Inflate 2.223 ();
  6         105  
  6         152  
12              
13              
14 6     6   1995 use IO::Uncompress::Base 2.223 ;
  6         90  
  6         283  
15 6     6   2106 use IO::Uncompress::Gunzip 2.223 ;
  6         86  
  6         331  
16 6     6   2312 use IO::Uncompress::Inflate 2.223 ;
  6         113  
  6         287  
17 6     6   48 use IO::Uncompress::RawInflate 2.223 ;
  6         46  
  6         163  
18 6     6   2927 use IO::Uncompress::Unzip 2.223 ;
  6         116  
  6         3108  
19              
20             require Exporter ;
21              
22             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
23              
24             $VERSION = '2.223';
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 132323 my $class = shift ;
39 36         104 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError);
40 36         128 $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 262 return ( 'rawinflate' => [Parse_boolean, 0] ) ;
52             }
53              
54             sub ckParams
55             {
56 36     36 0 40 my $self = shift ;
57 36         36 my $got = shift ;
58              
59             # any always needs both crc32 and adler32
60 36         92 $got->setValue('crc32' => 1);
61 36         67 $got->setValue('adler32' => 1);
62              
63 36         62 return 1;
64             }
65              
66             sub mkUncomp
67             {
68 36     36 0 40 my $self = shift ;
69 36         42 my $got = shift ;
70              
71 36         98 my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();
72              
73 36 50       68 return $self->saveErrorString(undef, $errstr, $errno)
74             if ! defined $obj;
75              
76 36         185 *$self->{Uncomp} = $obj;
77              
78 36         79 my @possible = qw( Inflate Gunzip Unzip );
79 36 100       95 unshift @possible, 'RawInflate'
80             if $got->getValue('rawinflate');
81              
82 36         85 my $magic = $self->ckMagic( @possible );
83              
84 36 100       72 if ($magic) {
85 32 50       64 *$self->{Info} = $self->readHeader($magic)
86             or return undef ;
87              
88 32         123 return 1;
89             }
90              
91 4         9 return 0 ;
92             }
93              
94              
95              
96             sub ckMagic
97             {
98 36     36 0 47 my $self = shift;
99 36         83 my @names = @_ ;
100              
101 36         54 my $keep = ref $self ;
102 36         66 for my $class ( map { "IO::Uncompress::$_" } @names)
  140         254  
103             {
104 92         275 bless $self => $class;
105 92         289 my $magic = $self->ckMagic();
106              
107 92 100       133 if ($magic)
108             {
109             #bless $self => $class;
110 32         85 return $magic ;
111             }
112              
113 60         125 $self->pushBack(*$self->{HeaderPending}) ;
114 60         130 *$self->{HeaderPending} = '' ;
115             }
116              
117 4         11 bless $self => $keep;
118 4         8 return undef;
119             }
120              
121             1 ;
122              
123             __END__