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   561 use strict;
  2         3  
  2         70  
4 2     2   11 use warnings;
  2         3  
  2         62  
5              
6 2     2   1561 use Archive::Tar;
  2         163885  
  2         166  
7 2     2   20 use File::Spec;
  2         3  
  2         493  
8              
9             sub new {
10 30     30 0 988 my ( $class, $path ) = @_;
11              
12 30         177 my $self = {
13             archivefile => $path,
14             };
15              
16 30         146 return bless $self, $class;
17             }
18              
19             require Enbld::Error;
20              
21             sub extract {
22 30     30 0 94 my ( $self, $dir ) = @_;
23              
24 30         462 my ( undef, undef, $file ) = File::Spec->splitpath( $self->{archivefile} );
25              
26 30         436 require Enbld::Message;
27 30         238 Enbld::Message->notify( "--> Extract archive file '$file'." );
28              
29 30         435 my $tar = Archive::Tar->new;
30 30 50       633 $tar->read( $self->{archivefile} ) or
31             _err( "Can't read archive file.", $tar->error );
32              
33 30 50       327915 my @list = $tar->list_files or _err( "Can't list up file.", $tar->error );
34              
35 30         3725 my @frag = split( '/', $list[0] );
36              
37 30         518 my $path = File::Spec->catdir( $dir, $frag[0] );
38 30 50       189 $tar->setcwd( $dir ) or _err( "Can't move to cwd dir.", $tar->error );
39 30 50       350 $tar->extract or _err( "Can't extract archive file.", $tar->error );
40              
41 30         95383 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;