diff options
Diffstat (limited to 'Master/tlpkg/tlperl/lib/IO/Wrap.pm')
| -rwxr-xr-x | Master/tlpkg/tlperl/lib/IO/Wrap.pm | 222 |
1 files changed, 222 insertions, 0 deletions
diff --git a/Master/tlpkg/tlperl/lib/IO/Wrap.pm b/Master/tlpkg/tlperl/lib/IO/Wrap.pm new file mode 100755 index 00000000000..5a28392dd23 --- /dev/null +++ b/Master/tlpkg/tlperl/lib/IO/Wrap.pm @@ -0,0 +1,222 @@ +package IO::Wrap; + +# SEE DOCUMENTATION AT BOTTOM OF FILE + +require 5.002; + +use strict; +use vars qw(@ISA @EXPORT $VERSION); +@ISA = qw(Exporter); +@EXPORT = qw(wraphandle); + +use FileHandle; +use Carp; + +# The package version, both in 1.23 style *and* usable by MakeMaker: +$VERSION = "2.110"; + + +#------------------------------ +# wraphandle RAW +#------------------------------ +sub wraphandle { + my $raw = shift; + new IO::Wrap $raw; +} + +#------------------------------ +# new STREAM +#------------------------------ +sub new { + my ($class, $stream) = @_; + no strict 'refs'; + + ### Convert raw scalar to globref: + ref($stream) or $stream = \*$stream; + + ### Wrap globref and incomplete objects: + if ((ref($stream) eq 'GLOB') or ### globref + (ref($stream) eq 'FileHandle') && !defined(&FileHandle::read)) { + return bless \$stream, $class; + } + $stream; ### already okay! +} + +#------------------------------ +# I/O methods... +#------------------------------ +sub close { + my $self = shift; + return close($$self); +} +sub getline { + my $self = shift; + my $fh = $$self; + return scalar(<$fh>); +} +sub getlines { + my $self = shift; + wantarray or croak("Can't call getlines in scalar context!"); + my $fh = $$self; + <$fh>; +} +sub print { + my $self = shift; + print { $$self } @_; +} +sub read { + my $self = shift; + return read($$self, $_[0], $_[1]); +} +sub seek { + my $self = shift; + return seek($$self, $_[0], $_[1]); +} +sub tell { + my $self = shift; + return tell($$self); +} + +#------------------------------ +1; +__END__ + + +=head1 NAME + +IO::Wrap - wrap raw filehandles in IO::Handle interface + + +=head1 SYNOPSIS + + use IO::Wrap; + + ### Do stuff with any kind of filehandle (including a bare globref), or + ### any kind of blessed object that responds to a print() message. + ### + sub do_stuff { + my $fh = shift; + + ### At this point, we have no idea what the user gave us... + ### a globref? a FileHandle? a scalar filehandle name? + + $fh = wraphandle($fh); + + ### At this point, we know we have an IO::Handle-like object! + + $fh->print("Hey there!"); + ... + } + + +=head1 DESCRIPTION + +Let's say you want to write some code which does I/O, but you don't +want to force the caller to provide you with a FileHandle or IO::Handle +object. You want them to be able to say: + + do_stuff(\*STDOUT); + do_stuff('STDERR'); + do_stuff($some_FileHandle_object); + do_stuff($some_IO_Handle_object); + +And even: + + do_stuff($any_object_with_a_print_method); + +Sure, one way to do it is to force the caller to use tiehandle(). +But that puts the burden on them. Another way to do it is to +use B<IO::Wrap>, which provides you with the following functions: + + +=over 4 + +=item wraphandle SCALAR + +This function will take a single argument, and "wrap" it based on +what it seems to be... + +=over 4 + +=item * + +B<A raw scalar filehandle name,> like C<"STDOUT"> or C<"Class::HANDLE">. +In this case, the filehandle name is wrapped in an IO::Wrap object, +which is returned. + +=item * + +B<A raw filehandle glob,> like C<\*STDOUT>. +In this case, the filehandle glob is wrapped in an IO::Wrap object, +which is returned. + +=item * + +B<A blessed FileHandle object.> +In this case, the FileHandle is wrapped in an IO::Wrap object if and only +if your FileHandle class does not support the C<read()> method. + +=item * + +B<Any other kind of blessed object,> which is assumed to be already +conformant to the IO::Handle interface. +In this case, you just get back that object. + +=back + +=back + + +If you get back an IO::Wrap object, it will obey a basic subset of +the IO:: interface. That is, the following methods (note: I said +I<methods>, not named operators) should work on the thing you get back: + + close + getline + getlines + print ARGS... + read BUFFER,NBYTES + seek POS,WHENCE + tell + + + +=head1 NOTES + +Clearly, when wrapping a raw external filehandle (like \*STDOUT), +I didn't want to close the file descriptor when the "wrapper" object is +destroyed... since the user might not appreciate that! Hence, +there's no DESTROY method in this class. + +When wrapping a FileHandle object, however, I believe that Perl will +invoke the FileHandle::DESTROY when the last reference goes away, +so in that case, the filehandle is closed if the wrapped FileHandle +really was the last reference to it. + + +=head1 WARNINGS + +This module does not allow you to wrap filehandle names which are given +as strings that lack the package they were opened in. That is, if a user +opens FOO in package Foo, they must pass it to you either as C<\*FOO> +or as C<"Foo::FOO">. However, C<"STDIN"> and friends will work just fine. + + +=head1 VERSION + +$Id: Wrap.pm,v 1.2 2005/02/10 21:21:53 dfs Exp $ + + +=head1 AUTHOR + +=item Primary Maintainer + +David F. Skoll (F<dfs@roaringpenguin.com>). + +=item Original Author + +Eryq (F<eryq@zeegee.com>). +President, ZeeGee Software Inc (F<http://www.zeegee.com>). + +=cut + |