File Coverage

blib/lib/IO/Uncompress/UnXz.pm
Criterion Covered Total %
statement 16 18 88.8
branch n/a
condition n/a
subroutine 6 6 100.0
pod n/a
total 22 24 91.6


line stmt bran cond sub pod time code
1             package IO::Uncompress::UnXz ;
2              
3 9     9   5336 use strict ;
  9         9  
  9         195  
4 9     9   25 use warnings;
  9         9  
  9         155  
5 9     9   25 use bytes;
  9         11  
  9         28  
6              
7 9     9   206 use IO::Compress::Base::Common 2.072 qw(:Status createSelfTiedObject);
  9         121  
  9         834  
8              
9 9     9   39 use IO::Uncompress::Base 2.072 ;
  9         111  
  9         339  
10 9     9   1374 use IO::Uncompress::Adapter::UnXz 2.072 ;
  0            
  0            
11              
12             require Exporter ;
13             our ($VERSION, @ISA, @EXPORT_OK, %EXPORT_TAGS, $UnXzError);
14              
15             $VERSION = '2.072';
16             $UnXzError = '';
17              
18             @ISA = qw( Exporter IO::Uncompress::Base );
19             @EXPORT_OK = qw( $UnXzError unxz ) ;
20             #%EXPORT_TAGS = %IO::Uncompress::Base::EXPORT_TAGS ;
21             push @{ $EXPORT_TAGS{all} }, @EXPORT_OK ;
22             #Exporter::export_ok_tags('all');
23              
24              
25             sub new
26             {
27             my $class = shift ;
28             my $obj = createSelfTiedObject($class, \$UnXzError);
29              
30             $obj->_create(undef, 0, @_);
31             }
32              
33             sub unxz
34             {
35             my $obj = createSelfTiedObject(undef, \$UnXzError);
36             return $obj->_inf(@_);
37             }
38              
39             our %PARAMS = (
40             'memlimit' => [IO::Compress::Base::Common::Parse_unsigned, 128 * 1024 * 1024],
41             'flags' => [IO::Compress::Base::Common::Parse_boolean, 0],
42             );
43              
44             sub getExtraParams
45             {
46             return %PARAMS ;
47             }
48              
49              
50             sub ckParams
51             {
52             my $self = shift ;
53             my $got = shift ;
54              
55             return 1;
56             }
57              
58             sub mkUncomp
59             {
60             my $self = shift ;
61             my $got = shift ;
62              
63             my $magic = $self->ckMagic()
64             or return 0;
65              
66             *$self->{Info} = $self->readHeader($magic)
67             or return undef ;
68              
69             my $memlimit = $got->getValue('memlimit');
70             my $flags = $got->getValue('flags');
71              
72             my ($obj, $errstr, $errno) = IO::Uncompress::Adapter::UnXz::mkUncompObject(
73             $memlimit, $flags);
74              
75             return $self->saveErrorString(undef, $errstr, $errno)
76             if ! defined $obj;
77            
78             *$self->{Uncomp} = $obj;
79              
80             return 1;
81              
82             }
83              
84              
85             use constant XZ_ID_SIZE => 6;
86             use constant XZ_MAGIC => "\0xFD". '7zXZ'. "\0x00" ;
87              
88             sub ckMagic
89             {
90             my $self = shift;
91              
92             my $magic ;
93             $self->smartReadExact(\$magic, XZ_ID_SIZE);
94              
95             *$self->{HeaderPending} = $magic ;
96            
97             return $self->HeaderError("Header size is " .
98             XZ_ID_SIZE . " bytes")
99             if length $magic != XZ_ID_SIZE;
100              
101             return $self->HeaderError("Bad Magic.")
102             if ! isXzMagic($magic) ;
103            
104            
105             *$self->{Type} = 'xz';
106             return $magic;
107             }
108              
109             sub readHeader
110             {
111             my $self = shift;
112             my $magic = shift ;
113              
114             $self->pushBack($magic);
115             *$self->{HeaderPending} = '';
116              
117              
118             return {
119             'Type' => 'xz',
120             'FingerprintLength' => XZ_ID_SIZE,
121             'HeaderLength' => XZ_ID_SIZE,
122             'TrailerLength' => 0,
123             'Header' => '$magic'
124             };
125            
126             }
127              
128             sub chkTrailer
129             {
130             return STATUS_OK;
131             }
132              
133              
134              
135             sub isXzMagic
136             {
137             my $buffer = shift ;
138             return $buffer =~ /^\xFD\x37\x7A\x58\x5A\x00/;
139             }
140              
141             1 ;
142              
143             __END__