lib/Archive/Zip/MemberRead.pm

   1 package Archive::Zip::MemberRead;
   2
   3 =head1 NAME
   4
   5 Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files.
   6
   7 =cut
   8
   9 =head1 SYNOPSIS
  10
  11   use Archive::Zip;
  12   use Archive::Zip::MemberRead;
  13   $zip = Archive::Zip->new("file.zip");
  14   $fh  = Archive::Zip::MemberRead->new($zip, "subdir/abc.txt");
  15   while (defined($line = $fh->getline()))
  16   {
  17       print $fh->input_line_number . "#: $line\n";
  18   }
  19
  20   $read = $fh->read($buffer, 32*1024);
  21   print "Read $read bytes as :$buffer:\n";
  22
  23 =head1 DESCRIPTION
  24
  25 The Archive::Zip::MemberRead module lets you read Zip archive member data
  26 just like you read data from files.
  27
  28 =head1 METHODS
  29
  30 =over 4
  31
  32 =cut
  33
  34 use strict;
  35
  36 use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
  37
  38 use vars qw{$VERSION};
  39
  40 my $nl;
  41
  42 BEGIN {
  43     $VERSION = '1.28';
  44     $VERSION = eval $VERSION;
  45      # Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy.
  46      $nl = $^O eq 'MSWin32' ? "\r\n" : "\n";
  47 }
  48
  49 =item Archive::Zip::Member::readFileHandle()
  50
  51 You can get a C<Archive::Zip::MemberRead> from an archive member by
  52 calling C<readFileHandle()>:
  53
  54   my $member = $zip->memberNamed('abc/def.c');
  55   my $fh = $member->readFileHandle();
  56   while (defined($line = $fh->getline()))
  57   {
  58       # ...
  59   }
  60   $fh->close();
  61
  62 =cut
  63
  64 sub Archive::Zip::Member::readFileHandle {
  65     return Archive::Zip::MemberRead->new( shift() );
  66 }
  67
  68 =item Archive::Zip::MemberRead->new($zip, $fileName)
  69
  70 =item Archive::Zip::MemberRead->new($zip, $member)
  71
  72 =item Archive::Zip::MemberRead->new($member)
  73
  74 Construct a new Archive::Zip::MemberRead on the specified member.
  75
  76   my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c')
  77
  78 =cut
  79
  80 sub new {
  81     my ( $class, $zip, $file ) = @_;
  82     my ( $self, $member );
  83
  84     if ( $zip && $file )    # zip and filename, or zip and member
  85     {
  86         $member = ref($file) ? $file : $zip->memberNamed($file);
  87     }
  88     elsif ( $zip && !$file && ref($zip) )    # just member
  89     {
  90         $member = $zip;
  91     }
  92     else {
  93         die(
  94 'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
  95         );
  96     }
  97
  98     $self = {};
  99     bless( $self, $class );
 100     $self->set_member($member);
 101     return $self;
 102 }
 103
 104 sub set_member {
 105     my ( $self, $member ) = @_;
 106
 107     $self->{member} = $member;
 108     $self->set_compression(COMPRESSION_STORED);
 109     $self->rewind();
 110 }
 111
 112 sub set_compression {
 113     my ( $self, $compression ) = @_;
 114     $self->{member}->desiredCompressionMethod($compression) if $self->{member};
 115 }
 116
 117 =item setLineEnd(expr)
 118
 119 Set the line end character to use. This is set to \n by default
 120 except on Windows systems where it is set to \r\n. You will
 121 only need to set this on systems which are not Windows or Unix
 122 based and require a line end diffrent from \n.
 123 This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)>
 124
 125 =cut
 126
 127 sub setLineEnd {
 128     shift;
 129     $nl = shift;
 130 }
 131
 132 =item rewind()
 133
 134 Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again
 135 starting at the beginning.
 136
 137 =cut
 138
 139 sub rewind {
 140     my $self = shift;
 141
 142     $self->_reset_vars();
 143     $self->{member}->rewindData() if $self->{member};
 144 }
 145
 146 sub _reset_vars {
 147     my $self = shift;
 148
 149     $self->{line_no} = 0;
 150     $self->{at_end}  = 0;
 151
 152     delete $self->{buffer};
 153 }
 154
 155 =item input_record_separator(expr)
 156
 157 If the argumnet is given, input_record_separator for this
 158 instance is set to it. The current setting (which may be
 159 the global $/) is always returned.
 160
 161 =cut
 162
 163 sub input_record_separator {
 164     my $self = shift;
 165      if (@_) {
 166          $self->{sep}    = shift;
 167          $self->{sep_re} = _sep_as_re($self->{sep}); # Cache the RE as an optimization
 168      }
 169      return exists $self->{sep} ? $self->{sep} : $/;
 170 }
 171
 172 # Return the input_record_separator in use as an RE fragment
 173 # Note that if we have a per-instance input_record_separator
 174 # we can just return the already converted value. Otherwise,
 175 # the conversion must be done on $/ every time since we cannot
 176 # know whether it has changed or not.
 177 sub _sep_re {
 178     my $self = shift;
 179     # Important to phrase this way: sep's value may be undef.
 180     return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/);
 181 }
 182
 183 # Convert the input record separator into an RE and return it.
 184 sub _sep_as_re {
 185     my $sep = shift;
 186     if (defined $sep) {
 187         if ($sep eq '') {
 188             return "(?:$nl){2,}";
 189         } else {
 190             $sep =~ s/\n/$nl/og;
 191             return quotemeta $sep;
 192         }
 193     } else {
 194         return undef;
 195     }
 196 }
 197
 198 =item input_line_number()
 199
 200 Returns the current line number, but only if you're using C<getline()>.
 201 Using C<read()> will not update the line number.
 202
 203 =cut
 204
 205 sub input_line_number {
 206     my $self = shift;
 207     return $self->{line_no};
 208 }
 209
 210 =item close()
 211
 212 Closes the given file handle.
 213
 214 =cut
 215
 216 sub close {
 217     my $self = shift;
 218
 219     $self->_reset_vars();
 220     $self->{member}->endRead();
 221 }
 222
 223 =item buffer_size([ $size ])
 224
 225 Gets or sets the buffer size used for reads.
 226 Default is the chunk size used by Archive::Zip.
 227
 228 =cut
 229
 230 sub buffer_size {
 231     my ( $self, $size ) = @_;
 232
 233     if ( !$size ) {
 234         return $self->{chunkSize} || Archive::Zip::chunkSize();
 235     }
 236     else {
 237         $self->{chunkSize} = $size;
 238     }
 239 }
 240
 241 =item getline()
 242
 243 Returns the next line from the currently open member.
 244 Makes sense only for text files.
 245 A read error is considered fatal enough to die.
 246 Returns undef on eof. All subsequent calls would return undef,
 247 unless a rewind() is called.
 248 Note: The line returned has the input_record_separator (default: newline) removed.
 249
 250 =cut
 251
 252 sub getline {
 253     my $self = shift;
 254     my $size = $self->buffer_size();
 255     my $sep  = $self->_sep_re();
 256
 257     for (;;) {
 258         if (   $sep
 259             && defined($self->{buffer})
 260             && $self->{buffer} =~ s/^(.*?)$sep//s
 261            ) {
 262             $self->{line_no}++;
 263             return $1;
 264         } elsif ($self->{at_end}) {
 265             $self->{line_no}++ if $self->{buffer};
 266             return delete $self->{buffer};
 267         }
 268         my ($temp,$status) = $self->{member}->readChunk($size);
 269         if ($status != AZ_OK && $status != AZ_STREAM_END) {
 270             die "ERROR: Error reading chunk from archive - $status";
 271         }
 272         $self->{at_end} = $status == AZ_STREAM_END;
 273         $self->{buffer} .= $$temp;
 274     }
 275 }
 276
 277 =item read($buffer, $num_bytes_to_read)
 278
 279 Simulates a normal C<read()> system call.
 280 Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>:
 281
 282   $fh = Archive::Zip::MemberRead->new($zip, "sreeji/secrets.bin");
 283   while (1)
 284   {
 285     $read = $fh->read($buffer, 1024);
 286     die "FATAL ERROR reading my secrets !\n" if (!defined($read));
 287     last if (!$read);
 288     # Do processing.
 289     ....
 290    }
 291
 292 =cut
 293
 294 #
 295 # All these $_ are required to emulate read().
 296 #
 297 sub read {
 298     my $self = $_[0];
 299     my $size = $_[2];
 300     my ( $temp, $status, $ret );
 301
 302     ( $temp, $status ) = $self->{member}->readChunk($size);
 303     if ( $status != AZ_OK && $status != AZ_STREAM_END ) {
 304         $_[1] = undef;
 305         $ret = undef;
 306     }
 307     else {
 308         $_[1] = $$temp;
 309         $ret = length($$temp);
 310     }
 311     return $ret;
 312 }
 313
 314 1;
 315
 316 =back
 317
 318 =head1 AUTHOR
 319
 320 Sreeji K. Das, <sreeji_k@yahoo.com>
 321 See L<Archive::Zip> by Ned Konz without which this module does not make
 322 any sense!
 323
 324 Minor mods by Ned Konz.
 325
 326 =head1 COPYRIGHT
 327
 328 Copyright 2002 Sreeji K. Das.
 329
 330 This program is free software; you can redistribute it and/or modify it under
 331 the same terms as Perl itself.
 332
 333 =cut