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   23980 use strict;
  6         10  
  6         163  
6 6     6   21 use warnings;
  6         17  
  6         273  
7 6     6   1517 use bytes;
  6         1531  
  6         27  
8              
9 6     6   1950 use IO::Compress::Base::Common 2.222 qw(:Parse);
  6         132  
  6         770  
10              
11 6     6   1629 use IO::Uncompress::Adapter::Inflate 2.222 ();
  6         122  
  6         174  
12              
13              
14 6     6   1874 use IO::Uncompress::Base 2.222 ;
  6         110  
  6         374  
15 6     6   2089 use IO::Uncompress::Gunzip 2.222 ;
  6         136  
  6         264  
16 6     6   2330 use IO::Uncompress::Inflate 2.222 ;
  6         113  
  6         299  
17 6     6   27 use IO::Uncompress::RawInflate 2.222 ;
  6         51  
  6         215  
18 6     6   3021 use IO::Uncompress::Unzip 2.222 ;
  6         99  
  6         3011  
19              
20             require Exporter ;
21              
22             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $AnyInflateError);
23              
24             $VERSION = '2.222';
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 137634 my $class = shift ;
39 36         102 my $obj = IO::Compress::Base::Common::createSelfTiedObject($class, \$AnyInflateError);
40 36         121 $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 246 return ( 'rawinflate' => [Parse_boolean, 0] ) ;
52             }
53              
54             sub ckParams
55             {
56 36     36 0 58 my $self = shift ;
57 36         45 my $got = shift ;
58              
59             # any always needs both crc32 and adler32
60 36         92 $got->setValue('crc32' => 1);
61 36         66 $got->setValue('adler32' => 1);
62              
63 36         65 return 1;
64             }
65              
66             sub mkUncomp
67             {
68 36     36 0 43 my $self = shift ;
69 36         48 my $got = shift ;
70              
71 36         92 my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::Inflate::mkUncompObject();
72              
73 36 50       79 return $self->saveErrorString(undef, $errstr, $errno)
74             if ! defined $obj;
75              
76 36         179 *$self->{Uncomp} = $obj;
77              
78 36         77 my @possible = qw( Inflate Gunzip Unzip );
79 36 100       88 unshift @possible, 'RawInflate'
80             if $got->getValue('rawinflate');
81              
82 36         86 my $magic = $self->ckMagic( @possible );
83              
84 36 100       65 if ($magic) {
85 32 50       69 *$self->{Info} = $self->readHeader($magic)
86             or return undef ;
87              
88 32         125 return 1;
89             }
90              
91 4         7 return 0 ;
92             }
93              
94              
95              
96             sub ckMagic
97             {
98 36     36 0 43 my $self = shift;
99 36         100 my @names = @_ ;
100              
101 36         88 my $keep = ref $self ;
102 36         61 for my $class ( map { "IO::Uncompress::$_" } @names)
  140         274  
103             {
104 92         251 bless $self => $class;
105 92         248 my $magic = $self->ckMagic();
106              
107 92 100       148 if ($magic)
108             {
109             #bless $self => $class;
110 32         81 return $magic ;
111             }
112              
113 60         127 $self->pushBack(*$self->{HeaderPending}) ;
114 60         93 *$self->{HeaderPending} = '' ;
115             }
116              
117 4         11 bless $self => $keep;
118 4         9 return undef;
119             }
120              
121             1 ;
122              
123             __END__