File Coverage

blib/lib/Footprintless/Extract.pm
Criterion Covered Total %
statement 77 78 98.7
branch 21 30 70.0
condition 5 12 41.6
subroutine 12 12 100.0
pod 2 2 100.0
total 117 134 87.3


line stmt bran cond sub pod time code
1 3     3   615 use strict;
  3         10  
  3         95  
2 3     3   17 use warnings;
  3         5  
  3         146  
3              
4             package Footprintless::Extract;
5             $Footprintless::Extract::VERSION = '1.29';
6             # ABSTRACT: Extracts data from archives
7             # PODNAME: Footprintless::Extract
8             #
9 3     3   22 use Carp;
  3         15  
  3         219  
10 3     3   15 use Cwd;
  3         5  
  3         195  
11 3     3   18 use File::Path qw(make_path);
  3         5  
  3         181  
12 3     3   16 use File::Spec;
  3         5  
  3         89  
13 3     3   15 use Log::Any;
  3         5  
  3         32  
14              
15             my $logger = Log::Any->get_logger();
16              
17             sub new {
18 8     8 1 233 return bless( {}, shift )->_init(@_);
19             }
20              
21             sub extract {
22 8     8 1 33 my ( $self, %options ) = @_;
23 8   33     35 my $to = $options{to} || getcwd();
24              
25 8         124 my $current_dir = getcwd();
26 8         22 eval {
27 8 50 66     48 croak("$to is not a directory") if ( -e $to && !-d $to );
28 8         874 make_path($to);
29 8         187 chdir($to);
30              
31 8 100       200 if ( $self->{type} eq 'zip' ) {
32 6         36 _unzip( $self->{archive}, $to );
33             }
34 8 100       362 if ( $self->{type} eq 'tar' ) {
35 2         8 _untar( $self->{archive}, $to );
36             }
37             };
38 8         35392 my $error = $@;
39 8         126 chdir($current_dir);
40 8 50       45 die($error) if ($error);
41              
42 8         134 return 1;
43             }
44              
45             sub _init {
46 8     8   51 my ( $self, %options ) = @_;
47              
48 8 50       40 croak('archive required') unless ( $options{archive} );
49 8         56 $self->{archive} = $options{archive};
50              
51 8 100       29 my $dot_extension = $options{type} ? ".$options{type}" : $self->{archive};
52 8 100       44 if ( $dot_extension =~ /\.zip|\.war|\.jar|\.ear|\.twbx$/ ) {
    50          
53 6         86 $self->{type} = 'zip';
54             }
55             elsif ( $dot_extension =~ /\.tar|\.tar\.gz|\.tgz$/ ) {
56 2         5 $self->{type} = 'tar';
57             }
58             else {
59 0         0 croak("unknown archive type");
60             }
61              
62 8         48 return $self;
63             }
64              
65             sub _untar {
66 2     2   5 my ( $archive, $to ) = @_;
67 2         17 $logger->tracef( 'untar [%s] to [%s]', $archive, $to );
68 2         618 require Archive::Tar;
69 2         71079 Archive::Tar->new($archive)->extract();
70             }
71              
72             sub _unzip {
73 6     6   22 my ( $archive, $to ) = @_;
74 6         37 $logger->tracef( 'unzip [%s] to [%s]', $archive, $to );
75 6         1875 require IO::Uncompress::Unzip;
76              
77 6   33     106280 my $unzip = IO::Uncompress::Unzip->new($archive)
78             || croak("unable to open $archive: $IO::Uncompress::Unzip::UnzipError");
79              
80 6         9501 my $status;
81 6         15 eval {
82 6         34 for ( $status = 1; $status > 0; $status = $unzip->nextStream() ) {
83 54         30386 my $header = $unzip->getHeaderInfo();
84 54         12054 my ( undef, $path, $name ) = File::Spec->splitpath( $header->{Name} );
85 54         354 my $dest_dir = File::Spec->catdir( $to, $path );
86              
87 54 100       1676 unless ( -d $dest_dir ) {
88 28 50       3648 make_path($dest_dir) || croak("unable to create dir $dest_dir: $!");
89             }
90              
91 54 100       169 unless ($name) {
92 28 50       61 last if ( $status < 0 );
93 28         129 next;
94             }
95              
96 26         201 my $dest_file = File::Spec->catfile( $dest_dir, $name );
97 26         55 my $buffer;
98 26   33     156 my $file = IO::File->new( $dest_file, "w" )
99             || croak("unable to create file $dest_file: $!");
100 26         3624 while ( ( $status = $unzip->read($buffer) ) > 0 ) {
101 26         17174 $file->write($buffer);
102             }
103 26         1334 $file->close();
104 26         880 my $stored_time = $header->{Time};
105 26 50       724 utime( $stored_time, $stored_time, $dest_file )
106             || croak("couldn't set utime on $dest_file: $!");
107             }
108 6 50       1264 croak("error processing $archive: $!") if ( $status < 0 );
109             };
110 6         23 my $error = $@;
111 6         35 $unzip->close();
112 6 50       200 die($error) if ($error);
113 6         30 return;
114             }
115              
116             1;
117              
118             __END__