| 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; |