File Coverage

blib/lib/Archive/Zip/NewFileMember.pm
Criterion Covered Total %
statement 43 43 100.0
branch 12 18 66.6
condition 4 9 44.4
subroutine 8 8 100.0
pod 2 2 100.0
total 69 80 86.2


line stmt bran cond sub pod time code
1             package Archive::Zip::NewFileMember;
2              
3 28     28   789 use strict;
  28         62  
  28         927  
4 28     28   168 use vars qw( $VERSION @ISA );
  28         56  
  28         1515  
5              
6             BEGIN {
7 28     28   91 $VERSION = '1.68';
8 28         1168 @ISA = qw ( Archive::Zip::FileMember );
9             }
10              
11 28         16260 use Archive::Zip qw(
12             :CONSTANTS
13             :ERROR_CODES
14             :UTILITY_METHODS
15 28     28   176 );
  28         54  
16              
17             # Given a file name, set up for eventual writing.
18             sub _newFromFileNamed {
19 201     201   335 my $class = shift;
20 201         296 my $fileName = shift; # local FS format
21 201         338 my $newName = shift;
22 201 100       444 $newName = _asZipDirName($fileName) unless defined($newName);
23 201 50 33     4623 return undef unless (stat($fileName) && -r _ && !-d _ );
      33        
24 201         1167 my $self = $class->new(@_);
25 201         361 $self->{'fileName'} = $newName;
26 201         402 $self->{'externalFileName'} = $fileName;
27 201         323 $self->{'compressionMethod'} = COMPRESSION_STORED;
28 201         664 my @stat = stat(_);
29 201         373 $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
30 201 100       565 $self->desiredCompressionMethod(
31             ($self->compressedSize() > 0)
32             ? COMPRESSION_DEFLATED
33             : COMPRESSION_STORED
34             );
35 201         544 $self->unixFileAttributes($stat[2]);
36 201         710 $self->setLastModFileDateTimeFromUnix($stat[9]);
37 201         9720 $self->isTextFile(-T _ );
38 201         612 return $self;
39             }
40              
41             sub rewindData {
42 145     145 1 348 my $self = shift;
43              
44 145         499 my $status = $self->SUPER::rewindData(@_);
45 145 50       549 return $status unless $status == AZ_OK;
46              
47 145 50       816 return AZ_IO_ERROR unless $self->fh();
48 145         387 $self->fh()->clearerr();
49 145 50       315 $self->fh()->seek(0, IO::Seekable::SEEK_SET)
50             or return _ioError("rewinding", $self->externalFileName());
51 145         2272 return AZ_OK;
52             }
53              
54             # Return bytes read. Note that first parameter is a ref to a buffer.
55             # my $data;
56             # my ( $bytesRead, $status) = $self->readRawChunk( \$data, $chunkSize );
57             sub _readRawChunk {
58 151     151   473 my ($self, $dataRef, $chunkSize) = @_;
59 151 50       363 return (0, AZ_OK) unless $chunkSize;
60 151 50       424 my $bytesRead = $self->fh()->read($$dataRef, $chunkSize)
61             or return (0, _ioError("reading data"));
62 151         4788 return ($bytesRead, AZ_OK);
63             }
64              
65             # If I already exist, extraction is a no-op.
66             sub extractToFileNamed {
67 51     51 1 110 my $self = shift;
68 51         87 my $name = shift; # local FS name
69 51 100 66     720 if (File::Spec->rel2abs($name) eq
70             File::Spec->rel2abs($self->externalFileName()) and -r $name) {
71 3         20 return AZ_OK;
72             } else {
73 48         244 return $self->SUPER::extractToFileNamed($name, @_);
74             }
75             }
76              
77             1;