commit more files of the tlperl.straw dir, still not complete

git-svn-id: svn://tug.org/texlive/trunk@17244 c570f23f-e606-0410-a88d-b1316a301751

1 files changed, 333 insertions, 0 deletions

diff --git a/Master/tlpkg/tlperl.straw/lib/Archive/Zip/MemberRead.pm b/Master/tlpkg/tlperl.straw/lib/Archive/Zip/MemberRead.pm
new file mode 100755
index 00000000000..a27bfdc45f0
--- /dev/null
+++ b/Master/tlpkg/tlperl.straw/lib/Archive/Zip/MemberRead.pm
@@ -0,0 +1,333 @@
+package Archive::Zip::MemberRead;
+
+=head1 NAME
+
+Archive::Zip::MemberRead - A wrapper that lets you read Zip archive members as if they were files.
+
+=cut
+
+=head1 SYNOPSIS
+
+  use Archive::Zip;
+  use Archive::Zip::MemberRead;
+  $zip = Archive::Zip->new("file.zip");
+  $fh  = Archive::Zip::MemberRead->new($zip, "subdir/abc.txt");
+  while (defined($line = $fh->getline()))
+  {
+      print $fh->input_line_number . "#: $line\n";
+  }
+
+  $read = $fh->read($buffer, 32*1024);
+  print "Read $read bytes as :$buffer:\n";
+
+=head1 DESCRIPTION
+
+The Archive::Zip::MemberRead module lets you read Zip archive member data
+just like you read data from files.
+
+=head1 METHODS
+
+=over 4
+
+=cut
+
+use strict;
+
+use Archive::Zip qw( :ERROR_CODES :CONSTANTS );
+
+use vars qw{$VERSION};
+
+my $nl;
+
+BEGIN {
+    $VERSION = '1.30';
+    $VERSION = eval $VERSION;
+     # Requirement for newline conversion. Should check for e.g., DOS and OS/2 as well, but am too lazy.
+     $nl = $^O eq 'MSWin32' ? "\r\n" : "\n";
+}
+
+=item Archive::Zip::Member::readFileHandle()
+
+You can get a C<Archive::Zip::MemberRead> from an archive member by
+calling C<readFileHandle()>:
+
+  my $member = $zip->memberNamed('abc/def.c');
+  my $fh = $member->readFileHandle();
+  while (defined($line = $fh->getline()))
+  {
+      # ...
+  }
+  $fh->close();
+
+=cut
+
+sub Archive::Zip::Member::readFileHandle {
+    return Archive::Zip::MemberRead->new( shift() );
+}
+
+=item Archive::Zip::MemberRead->new($zip, $fileName)
+
+=item Archive::Zip::MemberRead->new($zip, $member)
+
+=item Archive::Zip::MemberRead->new($member)
+
+Construct a new Archive::Zip::MemberRead on the specified member.
+
+  my $fh = Archive::Zip::MemberRead->new($zip, 'fred.c')
+
+=cut
+
+sub new {
+    my ( $class, $zip, $file ) = @_;
+    my ( $self, $member );
+
+    if ( $zip && $file )    # zip and filename, or zip and member
+    {
+        $member = ref($file) ? $file : $zip->memberNamed($file);
+    }
+    elsif ( $zip && !$file && ref($zip) )    # just member
+    {
+        $member = $zip;
+    }
+    else {
+        die(
+'Archive::Zip::MemberRead::new needs a zip and filename, zip and member, or member'
+        );
+    }
+
+    $self = {};
+    bless( $self, $class );
+    $self->set_member($member);
+    return $self;
+}
+
+sub set_member {
+    my ( $self, $member ) = @_;
+
+    $self->{member} = $member;
+    $self->set_compression(COMPRESSION_STORED);
+    $self->rewind();
+}
+
+sub set_compression {
+    my ( $self, $compression ) = @_;
+    $self->{member}->desiredCompressionMethod($compression) if $self->{member};
+}
+
+=item setLineEnd(expr)
+
+Set the line end character to use. This is set to \n by default
+except on Windows systems where it is set to \r\n. You will
+only need to set this on systems which are not Windows or Unix
+based and require a line end diffrent from \n.
+This is a class method so call as C<Archive::Zip::MemberRead>->C<setLineEnd($nl)>
+
+=cut
+
+sub setLineEnd {
+    shift;
+    $nl = shift;
+}
+
+=item rewind()
+
+Rewinds an C<Archive::Zip::MemberRead> so that you can read from it again
+starting at the beginning.
+
+=cut
+
+sub rewind {
+    my $self = shift;
+
+    $self->_reset_vars();
+    $self->{member}->rewindData() if $self->{member};
+}
+
+sub _reset_vars {
+    my $self = shift;
+
+    $self->{line_no} = 0;
+    $self->{at_end}  = 0;
+
+    delete $self->{buffer};
+}
+
+=item input_record_separator(expr)
+
+If the argumnet is given, input_record_separator for this
+instance is set to it. The current setting (which may be
+the global $/) is always returned.
+
+=cut
+
+sub input_record_separator {
+    my $self = shift;
+     if (@_) {
+         $self->{sep}    = shift;
+         $self->{sep_re} = _sep_as_re($self->{sep}); # Cache the RE as an optimization
+     }
+     return exists $self->{sep} ? $self->{sep} : $/;
+}
+
+# Return the input_record_separator in use as an RE fragment
+# Note that if we have a per-instance input_record_separator
+# we can just return the already converted value. Otherwise,
+# the conversion must be done on $/ every time since we cannot
+# know whether it has changed or not.
+sub _sep_re {
+    my $self = shift;
+    # Important to phrase this way: sep's value may be undef.
+    return exists $self->{sep} ? $self->{sep_re} : _sep_as_re($/);
+}
+
+# Convert the input record separator into an RE and return it.
+sub _sep_as_re {
+    my $sep = shift;
+    if (defined $sep) {
+        if ($sep eq '') {
+            return "(?:$nl){2,}";
+        } else {
+            $sep =~ s/\n/$nl/og;
+            return quotemeta $sep;
+        }
+    } else {
+        return undef;
+    }
+}
+
+=item input_line_number()
+
+Returns the current line number, but only if you're using C<getline()>.
+Using C<read()> will not update the line number.
+
+=cut
+
+sub input_line_number {
+    my $self = shift;
+    return $self->{line_no};
+}
+
+=item close()
+
+Closes the given file handle.
+
+=cut
+
+sub close {
+    my $self = shift;
+
+    $self->_reset_vars();
+    $self->{member}->endRead();
+}
+
+=item buffer_size([ $size ])
+
+Gets or sets the buffer size used for reads.
+Default is the chunk size used by Archive::Zip.
+
+=cut
+
+sub buffer_size {
+    my ( $self, $size ) = @_;
+
+    if ( !$size ) {
+        return $self->{chunkSize} || Archive::Zip::chunkSize();
+    }
+    else {
+        $self->{chunkSize} = $size;
+    }
+}
+
+=item getline()
+
+Returns the next line from the currently open member.
+Makes sense only for text files.
+A read error is considered fatal enough to die.
+Returns undef on eof. All subsequent calls would return undef,
+unless a rewind() is called.
+Note: The line returned has the input_record_separator (default: newline) removed.
+
+=cut
+
+sub getline {
+    my $self = shift;
+    my $size = $self->buffer_size();
+    my $sep  = $self->_sep_re();
+
+    for (;;) {
+        if (   $sep
+            && defined($self->{buffer})
+            && $self->{buffer} =~ s/^(.*?)$sep//s
+           ) {
+            $self->{line_no}++;
+            return $1;
+        } elsif ($self->{at_end}) {
+            $self->{line_no}++ if $self->{buffer};
+            return delete $self->{buffer};
+        }
+        my ($temp,$status) = $self->{member}->readChunk($size);
+        if ($status != AZ_OK && $status != AZ_STREAM_END) {
+            die "ERROR: Error reading chunk from archive - $status";
+        }
+        $self->{at_end} = $status == AZ_STREAM_END;
+        $self->{buffer} .= $$temp;
+    }
+}
+
+=item read($buffer, $num_bytes_to_read)
+
+Simulates a normal C<read()> system call.
+Returns the no. of bytes read. C<undef> on error, 0 on eof, I<e.g.>:
+
+  $fh = Archive::Zip::MemberRead->new($zip, "sreeji/secrets.bin");
+  while (1)
+  {
+    $read = $fh->read($buffer, 1024);
+    die "FATAL ERROR reading my secrets !\n" if (!defined($read));
+    last if (!$read);
+    # Do processing.
+    ....
+   }
+
+=cut
+
+#
+# All these $_ are required to emulate read().
+#
+sub read {
+    my $self = $_[0];
+    my $size = $_[2];
+    my ( $temp, $status, $ret );
+
+    ( $temp, $status ) = $self->{member}->readChunk($size);
+    if ( $status != AZ_OK && $status != AZ_STREAM_END ) {
+        $_[1] = undef;
+        $ret = undef;
+    }
+    else {
+        $_[1] = $$temp;
+        $ret = length($$temp);
+    }
+    return $ret;
+}
+
+1;
+
+=back
+
+=head1 AUTHOR
+
+Sreeji K. Das, <sreeji_k@yahoo.com>
+See L<Archive::Zip> by Ned Konz without which this module does not make
+any sense! 
+
+Minor mods by Ned Konz.
+
+=head1 COPYRIGHT
+
+Copyright 2002 Sreeji K. Das.
+
+This program is free software; you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut