File Coverage

blib/lib/File/Archive.pm
Criterion Covered Total %
statement 46 51 90.2
branch 15 18 83.3
condition 6 6 100.0
subroutine 8 8 100.0
pod 0 5 0.0
total 75 88 85.2


line stmt bran cond sub pod time code
1             package File::Archive;
2 1     1   651 use strict;
  1         1  
  1         48  
3 1     1   1292 use Archive::Tar qw(0.2);
  1         213743  
  1         178  
4 1     1   11 use Compress::Zlib;
  1         7  
  1         958  
5             $File::Archive::VERSION = '0.53';
6              
7             sub new {
8 5     5 0 240 my ($class, $file) = @_;
9 5         13 my $self = bless {}, $class;
10              
11 5         15 $self->{filename} = $file;
12              
13             # What type of file is it?
14 5         9 my $name = $self->{filename};
15 5 100       44 if ($name=~/\.(tar\.gz|tar\.Z|tgz)$/) {
    100          
    100          
16 1         3 $self->{type}="tarred compressed";
17 1         3 $self->{type_num} = 1;
18             }
19             elsif ($name=~/\.(gz|Z)$/) {
20 2         4 $self->{type}="compressed";
21 2         4 $self->{type_num} = 2;
22             }
23             elsif ($name=~/\.tar$/) {
24 1         3 $self->{type}="tarred";
25 1         2 $self->{type_num} = 3;
26             }
27             else {
28 1         3 $self->{type}="plain";
29 1         3 $self->{type_num} = 4;
30             }
31              
32 5         13 return $self;
33             }
34              
35             sub catalog {
36 5     5 0 36 my ($self) = @_;
37 5         5 my ($tar);
38              
39             # What's in the file?
40 5 100 100     31 if ($self->{type_num} == 4) {
    100          
41 1         5 return ($self->{filename});
42             }
43             elsif ($self->{type_num} == 1 || $self->{type_num} == 3) {
44 2         14 $tar = Archive::Tar->new();
45 2         30 return $tar->list_archive($self->{filename});
46             }
47             else {
48 2         4 my $name = $self->{filename};
49 2         9 $name =~ s/\.(Z|gz)$//;
50 2         8 return $name;
51             }
52             } # End method catalog
53              
54             sub member {
55 3     3 0 10459 my ($self, $file) = @_;
56 3         4 my ($contents, $tar, $gz, $line, $output);
57              
58             # What's in the files in the archive?
59 3 50 100     23 if ($self->{type_num} == 4) {
    100          
60 0         0 open (FILE, $self->{filename});
61 0         0 undef $/;
62 0         0 $contents = ;
63 0         0 close FILE;
64             }
65             elsif ($self->{type_num} == 1 || $self->{type_num} == 3) {
66 2         12 $tar = Archive::Tar->new($self->{filename});
67 2         8547 $contents = $tar->get_content($file);
68             } else {
69             # Actually, there's two things here
70 1 50       5 if ($self->{filename} =~ /\.(Z|zip|hqx|bz2?)$/) {
71 0         0 $contents = undef;
72             } else { # it's a gz file
73 1 50       6 $gz=gzopen($self->{filename}, "rb") or die
74             "Can't open file: $gzerrno\n";
75 1         1438 while ($gz->gzreadline($line)) {
76 18         1219 $contents .= $line;
77             } # Wend
78             } # End if..else
79             } # End file type test
80            
81 3         247 return $contents;
82             } # End sub member
83              
84             sub type {
85 1     1 0 12 my ($self) = @_;
86 1         3 return $self->{type};
87             }
88              
89             sub filename {
90 1     1 0 17 my ($self) = @_;
91 1         3 return $self->{filename};
92             }
93              
94             # get rid of annoying -w warnings
95             if ($^W) {
96             $File::Archive::VERSION = $File::Archive::VERSION;
97             }
98              
99             1;
100             __END__