| 5767 |
alewis |
1 |
package Archive::Zip::NewFileMember;
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use vars qw( $VERSION @ISA );
|
|
|
5 |
|
|
|
6 |
BEGIN {
|
|
|
7 |
$VERSION = '1.57';
|
|
|
8 |
@ISA = qw ( Archive::Zip::FileMember );
|
|
|
9 |
}
|
|
|
10 |
|
|
|
11 |
use Archive::Zip qw(
|
|
|
12 |
:CONSTANTS
|
|
|
13 |
:ERROR_CODES
|
|
|
14 |
:UTILITY_METHODS
|
|
|
15 |
);
|
|
|
16 |
|
|
|
17 |
# Given a file name, set up for eventual writing.
|
|
|
18 |
sub _newFromFileNamed {
|
|
|
19 |
my $class = shift;
|
|
|
20 |
my $fileName = shift; # local FS format
|
|
|
21 |
my $newName = shift;
|
|
|
22 |
$newName = _asZipDirName($fileName) unless defined($newName);
|
|
|
23 |
return undef unless (stat($fileName) && -r _ && !-d _ );
|
|
|
24 |
my $self = $class->new(@_);
|
|
|
25 |
$self->{'fileName'} = $newName;
|
|
|
26 |
$self->{'externalFileName'} = $fileName;
|
|
|
27 |
$self->{'compressionMethod'} = COMPRESSION_STORED;
|
|
|
28 |
my @stat = stat(_);
|
|
|
29 |
$self->{'compressedSize'} = $self->{'uncompressedSize'} = $stat[7];
|
|
|
30 |
$self->desiredCompressionMethod(
|
|
|
31 |
($self->compressedSize() > 0)
|
|
|
32 |
? COMPRESSION_DEFLATED
|
|
|
33 |
: COMPRESSION_STORED
|
|
|
34 |
);
|
|
|
35 |
$self->unixFileAttributes($stat[2]);
|
|
|
36 |
$self->setLastModFileDateTimeFromUnix($stat[9]);
|
|
|
37 |
$self->isTextFile(-T _ );
|
|
|
38 |
return $self;
|
|
|
39 |
}
|
|
|
40 |
|
|
|
41 |
sub rewindData {
|
|
|
42 |
my $self = shift;
|
|
|
43 |
|
|
|
44 |
my $status = $self->SUPER::rewindData(@_);
|
|
|
45 |
return $status unless $status == AZ_OK;
|
|
|
46 |
|
|
|
47 |
return AZ_IO_ERROR unless $self->fh();
|
|
|
48 |
$self->fh()->clearerr();
|
|
|
49 |
$self->fh()->seek(0, IO::Seekable::SEEK_SET)
|
|
|
50 |
or return _ioError("rewinding", $self->externalFileName());
|
|
|
51 |
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 |
my ($self, $dataRef, $chunkSize) = @_;
|
|
|
59 |
return (0, AZ_OK) unless $chunkSize;
|
|
|
60 |
my $bytesRead = $self->fh()->read($$dataRef, $chunkSize)
|
|
|
61 |
or return (0, _ioError("reading data"));
|
|
|
62 |
return ($bytesRead, AZ_OK);
|
|
|
63 |
}
|
|
|
64 |
|
|
|
65 |
# If I already exist, extraction is a no-op.
|
|
|
66 |
sub extractToFileNamed {
|
|
|
67 |
my $self = shift;
|
|
|
68 |
my $name = shift; # local FS name
|
|
|
69 |
if (File::Spec->rel2abs($name) eq
|
|
|
70 |
File::Spec->rel2abs($self->externalFileName()) and -r $name) {
|
|
|
71 |
return AZ_OK;
|
|
|
72 |
} else {
|
|
|
73 |
return $self->SUPER::extractToFileNamed($name, @_);
|
|
|
74 |
}
|
|
|
75 |
}
|
|
|
76 |
|
|
|
77 |
1;
|