diff options
author | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
---|---|---|
committer | Norbert Preining <preining@logic.at> | 2010-05-12 16:54:37 +0000 |
commit | 661c41a09e39a182865e0b51e34cc995a0dc96e8 (patch) | |
tree | 2f79bb1406e22fdcb2587be8ffda6c0c609d7932 /Master/tlpkg/tlperl/lib/PerlIO | |
parent | b645030efc22e13c2498a1522083634ab91b2de1 (diff) |
move tlperl.straw to tlperl
git-svn-id: svn://tug.org/texlive/trunk@18210 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Master/tlpkg/tlperl/lib/PerlIO')
-rwxr-xr-x | Master/tlpkg/tlperl/lib/PerlIO/encoding.pm | 53 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/lib/PerlIO/scalar.pm | 41 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/lib/PerlIO/via.pm | 243 | ||||
-rwxr-xr-x | Master/tlpkg/tlperl/lib/PerlIO/via/QuotedPrint.pm | 94 |
4 files changed, 431 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/PerlIO/encoding.pm b/Master/tlpkg/tlperl/lib/PerlIO/encoding.pm new file mode 100755 index 00000000000..f50c9c7b6f6 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/PerlIO/encoding.pm @@ -0,0 +1,53 @@ +package PerlIO::encoding; + +use strict; +our $VERSION = '0.11'; +our $DEBUG = 0; +$DEBUG and warn __PACKAGE__, " called by ", join(", ", caller), "\n"; + +# +# Equivalent of this is done in encoding.xs - do not uncomment. +# +# use Encode (); + +use XSLoader (); +XSLoader::load(__PACKAGE__, $VERSION); + +our $fallback = + Encode::PERLQQ()|Encode::WARN_ON_ERR()|Encode::STOP_AT_PARTIAL(); + +1; +__END__ + +=head1 NAME + +PerlIO::encoding - encoding layer + +=head1 SYNOPSIS + + use PerlIO::encoding; + + open($f, "<:encoding(foo)", "infoo"); + open($f, ">:encoding(bar)", "outbar"); + + use Encode qw(:fallbacks); + $PerlIO::encoding::fallback = FB_PERLQQ; + +=head1 DESCRIPTION + +This PerlIO layer opens a filehandle with a transparent encoding filter. + +On input, it converts the bytes expected to be in the specified +character set and encoding to Perl string data (Unicode and +Perl's internal Unicode encoding, UTF-8). On output, it converts +Perl string data into the specified character set and encoding. + +When the layer is pushed, the current value of C<$PerlIO::encoding::fallback> +is saved and used as the CHECK argument when calling the Encode methods +encode() and decode(). + +=head1 SEE ALSO + +L<open>, L<Encode>, L<perlfunc/binmode>, L<perluniintro> + +=cut diff --git a/Master/tlpkg/tlperl/lib/PerlIO/scalar.pm b/Master/tlpkg/tlperl/lib/PerlIO/scalar.pm new file mode 100755 index 00000000000..5188ddbc3c9 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/PerlIO/scalar.pm @@ -0,0 +1,41 @@ +package PerlIO::scalar; +our $VERSION = '0.07'; +use XSLoader (); +XSLoader::load 'PerlIO::scalar'; +1; +__END__ + +=head1 NAME + +PerlIO::scalar - in-memory IO, scalar IO + +=head1 SYNOPSIS + + my $scalar = ''; + ... + open my $fh, "<", \$scalar or die; + open my $fh, ">", \$scalar or die; + open my $fh, ">>", \$scalar or die; + +or + + my $scalar = ''; + ... + open my $fh, "<:scalar", \$scalar or die; + open my $fh, ">:scalar", \$scalar or die; + open my $fh, ">>:scalar", \$scalar or die; + +=head1 DESCRIPTION + +A filehandle is opened but the file operations are performed "in-memory" +on a scalar variable. All the normal file operations can be performed +on the handle. The scalar is considered a stream of bytes. Currently +fileno($fh) returns -1. + +=head1 IMPLEMENTATION NOTE + +C<PerlIO::scalar> only exists to use XSLoader to load C code that +provides support for treating a scalar as an "in memory" file. +One does not need to explicitly C<use PerlIO::scalar>. + +=cut diff --git a/Master/tlpkg/tlperl/lib/PerlIO/via.pm b/Master/tlpkg/tlperl/lib/PerlIO/via.pm new file mode 100755 index 00000000000..66aa974043e --- /dev/null +++ b/Master/tlpkg/tlperl/lib/PerlIO/via.pm @@ -0,0 +1,243 @@ +package PerlIO::via; +our $VERSION = '0.07'; +use XSLoader (); +XSLoader::load 'PerlIO::via'; +1; +__END__ + +=head1 NAME + +PerlIO::via - Helper class for PerlIO layers implemented in perl + +=head1 SYNOPSIS + + use PerlIO::via::Layer; + open($fh,"<:via(Layer)",...); + + use Some::Other::Package; + open($fh,">:via(Some::Other::Package)",...); + +=head1 DESCRIPTION + +The PerlIO::via module allows you to develop PerlIO layers in Perl, without +having to go into the nitty gritty of programming C with XS as the interface +to Perl. + +One example module, L<PerlIO::via::QuotedPrint>, is included with Perl +5.8.0, and more example modules are available from CPAN, such as +L<PerlIO::via::StripHTML> and L<PerlIO::via::Base64>. The +PerlIO::via::StripHTML module for instance, allows you to say: + + use PerlIO::via::StripHTML; + open( my $fh, "<:via(StripHTML)", "index.html" ); + my @line = <$fh>; + +to obtain the text of an HTML-file in an array with all the HTML-tags +automagically removed. + +Please note that if the layer is created in the PerlIO::via:: namespace, it +does B<not> have to be fully qualified. The PerlIO::via module will prefix +the PerlIO::via:: namespace if the specified modulename does not exist as a +fully qualified module name. + +=head1 EXPECTED METHODS + +To create a Perl module that implements a PerlIO layer in Perl (as opposed to +in C using XS as the interface to Perl), you need to supply some of the +following subroutines. It is recommended to create these Perl modules in the +PerlIO::via:: namespace, so that they can easily be located on CPAN and use +the default namespace feature of the PerlIO::via module itself. + +Please note that this is an area of recent development in Perl and that the +interface described here is therefore still subject to change (and hopefully +will have better documentation and more examples). + +In the method descriptions below I<$fh> will be +a reference to a glob which can be treated as a perl file handle. +It refers to the layer below. I<$fh> is not passed if the layer +is at the bottom of the stack, for this reason and to maintain +some level of "compatibility" with TIEHANDLE classes it is passed last. + +=over 4 + +=item $class->PUSHED([$mode,[$fh]]) + +Should return an object or the class, or -1 on failure. (Compare +TIEHANDLE.) The arguments are an optional mode string ("r", "w", +"w+", ...) and a filehandle for the PerlIO layer below. Mandatory. + +When the layer is pushed as part of an C<open> call, C<PUSHED> will be called +I<before> the actual open occurs, whether that be via C<OPEN>, C<SYSOPEN>, +C<FDOPEN> or by letting a lower layer do the open. + +=item $obj->POPPED([$fh]) + +Optional - called when the layer is about to be removed. + +=item $obj->UTF8($bellowFlag,[$fh]) + +Optional - if present it will be called immediately after PUSHED has +returned. It should return a true value if the layer expects data to be +UTF-8 encoded. If it returns true, the result is as if the caller had done + + ":via(YourClass):utf8" + +If not present or if it returns false, then the stream is left with +the UTF-8 flag clear. +The I<$bellowFlag> argument will be true if there is a layer below +and that layer was expecting UTF-8. + +=item $obj->OPEN($path,$mode,[$fh]) + +Optional - if not present a lower layer does the open. +If present, called for normal opens after the layer is pushed. +This function is subject to change as there is no easy way +to get a lower layer to do the open and then regain control. + +=item $obj->BINMODE([$fh]) + +Optional - if not present the layer is popped on binmode($fh) or when C<:raw> +is pushed. If present it should return 0 on success, -1 on error, or undef +to pop the layer. + +=item $obj->FDOPEN($fd,[$fh]) + +Optional - if not present a lower layer does the open. +If present, called after the layer is pushed for opens which pass +a numeric file descriptor. +This function is subject to change as there is no easy way +to get a lower layer to do the open and then regain control. + +=item $obj->SYSOPEN($path,$imode,$perm,[$fh]) + +Optional - if not present a lower layer does the open. +If present, called after the layer is pushed for sysopen style opens +which pass a numeric mode and permissions. +This function is subject to change as there is no easy way +to get a lower layer to do the open and then regain control. + +=item $obj->FILENO($fh) + +Returns a numeric value for a Unix-like file descriptor. Returns -1 if +there isn't one. Optional. Default is fileno($fh). + +=item $obj->READ($buffer,$len,$fh) + +Returns the number of octets placed in $buffer (must be less than or +equal to $len). Optional. Default is to use FILL instead. + +=item $obj->WRITE($buffer,$fh) + +Returns the number of octets from $buffer that have been successfully written. + +=item $obj->FILL($fh) + +Should return a string to be placed in the buffer. Optional. If not +provided, must provide READ or reject handles open for reading in +PUSHED. + +=item $obj->CLOSE($fh) + +Should return 0 on success, -1 on error. +Optional. + +=item $obj->SEEK($posn,$whence,$fh) + +Should return 0 on success, -1 on error. +Optional. Default is to fail, but that is likely to be changed +in future. + +=item $obj->TELL($fh) + +Returns file position. +Optional. Default to be determined. + +=item $obj->UNREAD($buffer,$fh) + +Returns the number of octets from $buffer that have been successfully +saved to be returned on future FILL/READ calls. Optional. Default is +to push data into a temporary layer above this one. + +=item $obj->FLUSH($fh) + +Flush any buffered write data. May possibly be called on readable +handles too. Should return 0 on success, -1 on error. + +=item $obj->SETLINEBUF($fh) + +Optional. No return. + +=item $obj->CLEARERR($fh) + +Optional. No return. + +=item $obj->ERROR($fh) + +Optional. Returns error state. Default is no error until a mechanism +to signal error (die?) is worked out. + +=item $obj->EOF($fh) + +Optional. Returns end-of-file state. Default is a function of the return +value of FILL or READ. + +=back + +=head1 EXAMPLES + +Check the PerlIO::via:: namespace on CPAN for examples of PerlIO layers +implemented in Perl. To give you an idea how simple the implementation of +a PerlIO layer can look, a simple example is included here. + +=head2 Example - a Hexadecimal Handle + +Given the following module, PerlIO::via::Hex : + + package PerlIO::via::Hex; + + sub PUSHED + { + my ($class,$mode,$fh) = @_; + # When writing we buffer the data + my $buf = ''; + return bless \$buf,$class; + } + + sub FILL + { + my ($obj,$fh) = @_; + my $line = <$fh>; + return (defined $line) ? pack("H*", $line) : undef; + } + + sub WRITE + { + my ($obj,$buf,$fh) = @_; + $$obj .= unpack("H*", $buf); + return length($buf); + } + + sub FLUSH + { + my ($obj,$fh) = @_; + print $fh $$obj or return -1; + $$obj = ''; + return 0; + } + + 1; + +The following code opens up an output handle that will convert any +output to a hexadecimal dump of the output bytes: for example "A" will +be converted to "41" (on ASCII-based machines, on EBCDIC platforms +the "A" will become "c1") + + use PerlIO::via::Hex; + open(my $fh, ">:via(Hex)", "foo.hex"); + +and the following code will read the hexdump in and convert it +on the fly back into bytes: + + open(my $fh, "<:via(Hex)", "foo.hex"); + +=cut diff --git a/Master/tlpkg/tlperl/lib/PerlIO/via/QuotedPrint.pm b/Master/tlpkg/tlperl/lib/PerlIO/via/QuotedPrint.pm new file mode 100755 index 00000000000..2434191f091 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/PerlIO/via/QuotedPrint.pm @@ -0,0 +1,94 @@ +package PerlIO::via::QuotedPrint; + +# Set the version info +# Make sure we do things by the book from now on + +$VERSION = '0.06'; +use strict; + +# Make sure the encoding/decoding stuff is available + +use MIME::QuotedPrint (); # no need to pollute this namespace + +# Satisfy -require- + +1; + +#----------------------------------------------------------------------- +# IN: 1 class to bless with +# 2 mode string (ignored) +# 3 file handle of PerlIO layer below (ignored) +# OUT: 1 blessed object + +sub PUSHED { bless \*PUSHED,$_[0] } #PUSHED + +#----------------------------------------------------------------------- +# IN: 1 instantiated object (ignored) +# 2 handle to read from +# OUT: 1 decoded string + +sub FILL { + +# Read the line from the handle +# Decode if there is something decode and return result or signal eof + + my $line = readline( $_[1] ); + (defined $line) ? MIME::QuotedPrint::decode_qp( $line ) : undef; +} #FILL + +#----------------------------------------------------------------------- +# IN: 1 instantiated object (ignored) +# 2 buffer to be written +# 3 handle to write to +# OUT: 1 number of bytes written + +sub WRITE { + +# Encode whatever needs to be encoded and write to handle: indicate result + + (print {$_[2]} MIME::QuotedPrint::encode_qp($_[1])) ? length($_[1]) : -1; +} #WRITE + +__END__ + +=head1 NAME + +PerlIO::via::QuotedPrint - PerlIO layer for quoted-printable strings + +=head1 SYNOPSIS + + use PerlIO::via::QuotedPrint; + + open( my $in,'<:via(QuotedPrint)','file.qp' ) + or die "Can't open file.qp for reading: $!\n"; + + open( my $out,'>:via(QuotedPrint)','file.qp' ) + or die "Can't open file.qp for writing: $!\n"; + +=head1 DESCRIPTION + +This module implements a PerlIO layer that works on files encoded in the +quoted-printable format. It will decode from quoted-printable while reading +from a handle, and it will encode as quoted-printable while writing to a handle. + +=head1 REQUIRED MODULES + + MIME::QuotedPrint (any) + +=head1 SEE ALSO + +L<PerlIO::via>, L<MIME::QuotedPrint>, L<PerlIO::via::Base64>, +L<PerlIO::via::MD5>, L<PerlIO::via::StripHTML>, L<PerlIO::via::Rotate>. + +=head1 ACKNOWLEDGEMENTS + +Based on example that was initially added to MIME::QuotedPrint.pm for the +5.8.0 distribution of Perl. + +=head1 COPYRIGHT + +Copyright (c) 2002-2003 Elizabeth Mattijsen. All rights reserved. This +library is free software; you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut |