File Coverage

blib/lib/Archive/Zip/NewFileMember.pm
Criterion Covered Total %
statement 43 43 100.0
branch 11 18 61.1
condition 4 9 44.4
subroutine 8 8 100.0
pod 2 2 100.0
total 68 80 85.0


line stmt bran cond sub pod time code
1             package Archive::Zip::NewFileMember;
2              
3 6     6   82 use strict;
  6         56  
  6         99  
4 6     6   94 use vars qw( $VERSION @ISA );
  6         55  
  6         695  
5              
6             BEGIN {
7 6     6   82     $VERSION = '1.18';
8 6         122     @ISA = qw ( Archive::Zip::FileMember );
9             }
10              
11 6         476 use Archive::Zip qw(
12             :CONSTANTS
13             :ERROR_CODES
14             :UTILITY_METHODS
15 6     6   189 );
  6         59  
16              
17             # Given a file name, set up for eventual writing.
18             sub _newFromFileNamed {
19 64     64   665     my $class = shift;
20 64         606     my $fileName = shift; # local FS format
21 64         630     my $newName = shift;
22 64 100       715     $newName = _asZipDirName($fileName) unless defined($newName);
23 64 50 33     2354     return undef unless ( stat($fileName) && -r _ && !-d _ );
      33        
24 64         1840     my $self = $class->new(@_);
25 64         971     $self->fileName($newName);
26 64         656     $self->{'externalFileName'} = $fileName;
27 64         591     $self->{'compressionMethod'} = COMPRESSION_STORED;
28 64         952     my @stat = stat(_);
29 64         764     $self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
30 64 50       836     $self->desiredCompressionMethod(
31                     ( $self->compressedSize() > 0 )
32                     ? COMPRESSION_DEFLATED
33                     : COMPRESSION_STORED
34                 );
35 64         742     $self->unixFileAttributes( $stat[2] );
36 64         889     $self->setLastModFileDateTimeFromUnix( $stat[9] );
37 64         9028     $self->isTextFile( -T _ );
38 64         819     return $self;
39             }
40              
41             sub rewindData {
42 21     21 1 283     my $self = shift;
43              
44 21         954     my $status = $self->SUPER::rewindData(@_);
45 21 50       234     return $status unless $status == AZ_OK;
46              
47 21 50       488     return AZ_IO_ERROR unless $self->fh();
48 21         254     $self->fh()->clearerr();
49 21 50       247     $self->fh()->seek( 0, IO::Seekable::SEEK_SET )
50                   or return _ioError( "rewinding", $self->externalFileName() );
51 21         1230     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 21     21   208     my ( $self, $dataRef, $chunkSize ) = @_;
59 21 50       230     return ( 0, AZ_OK ) unless $chunkSize;
60 21 50       244     my $bytesRead = $self->fh()->read( $$dataRef, $chunkSize )
61                   or return ( 0, _ioError("reading data") );
62 21         2502     return ( $bytesRead, AZ_OK );
63             }
64              
65             # If I already exist, extraction is a no-op.
66             sub extractToFileNamed {
67 4     4 1 132     my $self = shift;
68 4         90     my $name = shift; # local FS name
69 4 100 66     157     if ( File::Spec->rel2abs($name) eq
70                     File::Spec->rel2abs( $self->externalFileName() ) and -r $name )
71                 {
72 1         154         return AZ_OK;
73                 }
74                 else {
75 3         720         return $self->SUPER::extractToFileNamed( $name, @_ );
76                 }
77             }
78              
79             1;
80