File Coverage

blib/lib/Enbld/Archivefile.pm
Criterion Covered Total %
statement 27 30 90.0
branch 4 8 50.0
condition n/a
subroutine 6 7 85.7
pod 0 2 0.0
total 37 47 78.7


line stmt bran cond sub pod time code
1             package Enbld::Archivefile;
2              
3 2     2   841 use strict;
  2         4  
  2         66  
4 2     2   9 use warnings;
  2         5  
  2         49  
5              
6 2     2   2277 use Archive::Tar;
  2         246514  
  2         181  
7 2     2   27 use File::Spec;
  2         4  
  2         699  
8              
9             sub new {
10 30     30 0 1635 my ( $class, $path ) = @_;
11              
12 30         454 my $self = {
13             archivefile => $path,
14             };
15              
16 30         164 return bless $self, $class;
17             }
18              
19             require Enbld::Error;
20              
21             sub extract {
22 30     30 0 150 my ( $self, $dir ) = @_;
23              
24 30         571 my ( undef, undef, $file ) = File::Spec->splitpath( $self->{archivefile} );
25              
26 30         885 require Enbld::Message;
27 30         364 Enbld::Message->notify( "--> Extract archive file '$file'." );
28              
29 30         649 my $tar = Archive::Tar->new;
30 30 50       1047 $tar->read( $self->{archivefile} ) or
31             _err( "Can't read archive file.", $tar->error );
32              
33 30 50       456512 my @list = $tar->list_files or _err( "Can't list up file.", $tar->error );
34              
35 30         5128 my @frag = split( '/', $list[0] );
36              
37 30         594 my $path = File::Spec->catdir( $dir, $frag[0] );
38 30 50       292 $tar->setcwd( $dir ) or _err( "Can't move to cwd dir.", $tar->error );
39 30 50       372 $tar->extract or _err( "Can't extract archive file.", $tar->error );
40              
41 30         602048 return $path;
42             }
43              
44             sub _err {
45 0     0     my ( $err, $msg ) = @_;
46              
47 0           require Enbld::Error;
48 0           Enbld::Error->throw( $err, $msg );
49             }
50              
51             1;