1package IO::Wrap;
2
3# SEE DOCUMENTATION AT BOTTOM OF FILE
4
5require 5.002;
6
7use strict;
8use vars qw(@ISA @EXPORT $VERSION);
9@ISA = qw(Exporter);
10@EXPORT = qw(wraphandle);
11
12use FileHandle;
13use Carp;
14
15# The package version, both in 1.23 style *and* usable by MakeMaker:
16$VERSION = "2.110";
17
18
19#------------------------------
20# wraphandle RAW
21#------------------------------
22sub wraphandle {
23    my $raw = shift;
24    new IO::Wrap $raw;
25}
26
27#------------------------------
28# new STREAM
29#------------------------------
30sub new {
31    my ($class, $stream) = @_;
32    no strict 'refs';
33
34    ### Convert raw scalar to globref:
35    ref($stream) or $stream = \*$stream;
36
37    ### Wrap globref and incomplete objects:
38    if ((ref($stream) eq 'GLOB') or      ### globref
39	(ref($stream) eq 'FileHandle') && !defined(&FileHandle::read)) {
40	return bless \$stream, $class;
41    }
42    $stream;           ### already okay!
43}
44
45#------------------------------
46# I/O methods...
47#------------------------------
48sub close {
49    my $self = shift;
50    return close($$self);
51}
52sub getline {
53    my $self = shift;
54    my $fh = $$self;
55    return scalar(<$fh>);
56}
57sub getlines {
58    my $self = shift;
59    wantarray or croak("Can't call getlines in scalar context!");
60    my $fh = $$self;
61    <$fh>;
62}
63sub print {
64    my $self = shift;
65    print { $$self } @_;
66}
67sub read {
68    my $self = shift;
69    return read($$self, $_[0], $_[1]);
70}
71sub seek {
72    my $self = shift;
73    return seek($$self, $_[0], $_[1]);
74}
75sub tell {
76    my $self = shift;
77    return tell($$self);
78}
79
80#------------------------------
811;
82__END__
83
84
85=head1 NAME
86
87IO::Wrap - wrap raw filehandles in IO::Handle interface
88
89
90=head1 SYNOPSIS
91
92   use IO::Wrap;
93
94   ### Do stuff with any kind of filehandle (including a bare globref), or
95   ### any kind of blessed object that responds to a print() message.
96   ###
97   sub do_stuff {
98       my $fh = shift;
99
100       ### At this point, we have no idea what the user gave us...
101       ### a globref? a FileHandle? a scalar filehandle name?
102
103       $fh = wraphandle($fh);
104
105       ### At this point, we know we have an IO::Handle-like object!
106
107       $fh->print("Hey there!");
108       ...
109   }
110
111
112=head1 DESCRIPTION
113
114Let's say you want to write some code which does I/O, but you don't
115want to force the caller to provide you with a FileHandle or IO::Handle
116object.  You want them to be able to say:
117
118    do_stuff(\*STDOUT);
119    do_stuff('STDERR');
120    do_stuff($some_FileHandle_object);
121    do_stuff($some_IO_Handle_object);
122
123And even:
124
125    do_stuff($any_object_with_a_print_method);
126
127Sure, one way to do it is to force the caller to use tiehandle().
128But that puts the burden on them.  Another way to do it is to
129use B<IO::Wrap>, which provides you with the following functions:
130
131
132=over 4
133
134=item wraphandle SCALAR
135
136This function will take a single argument, and "wrap" it based on
137what it seems to be...
138
139=over 4
140
141=item *
142
143B<A raw scalar filehandle name,> like C<"STDOUT"> or C<"Class::HANDLE">.
144In this case, the filehandle name is wrapped in an IO::Wrap object,
145which is returned.
146
147=item *
148
149B<A raw filehandle glob,> like C<\*STDOUT>.
150In this case, the filehandle glob is wrapped in an IO::Wrap object,
151which is returned.
152
153=item *
154
155B<A blessed FileHandle object.>
156In this case, the FileHandle is wrapped in an IO::Wrap object if and only
157if your FileHandle class does not support the C<read()> method.
158
159=item *
160
161B<Any other kind of blessed object,> which is assumed to be already
162conformant to the IO::Handle interface.
163In this case, you just get back that object.
164
165=back
166
167=back
168
169
170If you get back an IO::Wrap object, it will obey a basic subset of
171the IO:: interface.  That is, the following methods (note: I said
172I<methods>, not named operators) should work on the thing you get back:
173
174    close
175    getline
176    getlines
177    print ARGS...
178    read BUFFER,NBYTES
179    seek POS,WHENCE
180    tell
181
182
183
184=head1 NOTES
185
186Clearly, when wrapping a raw external filehandle (like \*STDOUT),
187I didn't want to close the file descriptor when the "wrapper" object is
188destroyed... since the user might not appreciate that!  Hence,
189there's no DESTROY method in this class.
190
191When wrapping a FileHandle object, however, I believe that Perl will
192invoke the FileHandle::DESTROY when the last reference goes away,
193so in that case, the filehandle is closed if the wrapped FileHandle
194really was the last reference to it.
195
196
197=head1 WARNINGS
198
199This module does not allow you to wrap filehandle names which are given
200as strings that lack the package they were opened in. That is, if a user
201opens FOO in package Foo, they must pass it to you either as C<\*FOO>
202or as C<"Foo::FOO">.  However, C<"STDIN"> and friends will work just fine.
203
204
205=head1 VERSION
206
207$Id: Wrap.pm 1248 2008-03-25 00:51:31Z warnes $
208
209
210=head1 AUTHOR
211
212=item Primary Maintainer
213
214David F. Skoll (F<dfs@roaringpenguin.com>).
215
216=item Original Author
217
218Eryq (F<eryq@zeegee.com>).
219President, ZeeGee Software Inc (F<http://www.zeegee.com>).
220
221=cut
222
223