IO-Tee-0.64/0040755001356100135600000000000007252533437011025 5ustar kenuserIO-Tee-0.64/Makefile.PL0100644001356100135600000000051606515035535012773 0ustar kenuseruse ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'IO::Tee', 'VERSION_FROM' => 'Tee.pm', 'dist' => { COMPRESS => 'gzip -9f', SUFFIX => '.gz', DIST_DEFAULT => 'all tardist' }, ); IO-Tee-0.64/Tee.pm0100644001356100135600000002022007252533256012070 0ustar kenuserpackage IO::Tee; require 5.004; use strict; use Carp; use Symbol; use IO::Handle; use IO::File; use vars qw($VERSION @ISA); $VERSION = '0.64'; @ISA = 'IO::Handle'; # Constructor -- bless array reference into our class sub new { my $class = shift; my $self = gensym; @{*$self} = map { ! ref($_) ? IO::File->new($_) : ref($_) eq 'ARRAY' ? IO::File->new(@$_) : ref($_) eq 'GLOB' ? bless $_, 'IO::Handle' : $_ or return undef } @_; bless $self, $class; tie *$self, $class, $self; return $self; } # Return a list of all associated handles sub handles { @{*{$_[0]}}; } # Proxy routines for various IO::Handle and IO::File operations sub _method_return_success { my $method = (caller(1))[3]; $method =~ s/.*:://; my $self = shift; my $ret = 1; foreach my $fh (@{*$self}) { undef $ret unless $fh->$method(@_) } return $ret; } sub close { _method_return_success(@_) } sub truncate { _method_return_success(@_) } sub write { _method_return_success(@_) } sub syswrite { _method_return_success(@_) } sub format_write { _method_return_success(@_) } sub fcntl { _method_return_success(@_) } sub ioctl { _method_return_success(@_) } sub flush { _method_return_success(@_) } sub clearerr { _method_return_success(@_) } sub seek { _method_return_success(@_) } sub formline { my $self = shift; my $picture = shift; local($^A) = $^A; local($\) = ""; formline($picture, @_); my $ret = 1; foreach my $fh (@{*$self}) { undef $ret unless print $fh $^A } return $ret; } sub _state_modify { my $method = (caller(1))[3]; $method =~ s/.*:://; croak "$method values cannot be retrieved collectively" if @_ <= 1; my $self = shift; if (ref $self) { foreach my $fh (@{*$self}) { $fh->$method(@_) } } else { IO::Handle->$method(@_); } # Note that we do not return any "previous value" here } sub autoflush { _state_modify(@_) } sub output_field_separator { _state_modify(@_) } sub output_record_separator { _state_modify(@_) } sub format_page_number { _state_modify(@_) } sub format_lines_per_page { _state_modify(@_) } sub format_lines_left { _state_modify(@_) } sub format_name { _state_modify(@_) } sub format_top_name { _state_modify(@_) } sub format_line_break_characters { _state_modify(@_) } sub format_formfeed { _state_modify(@_) } sub input_record_separator { my $self = shift; my $ret = (ref $self ? ${*$self}[0] : 'IO::Handle') ->input_record_separator(@_); $ret; # This works around an apparent bug in Perl 5.004_04 } sub input_line_number { my $self = shift; my $ret = ${*$self}[0]->input_line_number(@_); $ret; # This works around an apparent bug in Perl 5.004_04 } # File handle tying interface sub TIEHANDLE { my ($class, $self) = @_; return bless *$self{ARRAY}, $class; } sub PRINT { my $self = shift; my $ret = 1; foreach my $fh (@$self) { undef $ret unless print $fh @_ } return $ret; } sub PRINTF { my $self = shift; my $fmt = shift; my $ret = 1; foreach my $fh (@$self) { undef $ret unless printf $fh $fmt, @_ } return $ret; } sub _multiplex_input { my ($self, $input) = @_; my $ret = 1; if (length $input) { for (my $i = 1; $i < @$self; ++$i) { undef $ret unless print {$self->[$i]} $input; } } $ret; } sub READ { my $self = shift; my $bytes = $self->[0]->read(@_); $bytes and $self->_multiplex_input(substr($_[0], $_[2], $bytes)); $bytes; } sub READLINE { my $self = shift; my $infh = $self->[0]; if (wantarray) { my @data; my $data; while (defined($data = <$infh>) and length($data)) { push @data, $data; $self->_multiplex_input($data); } @data; } else { my $data = <$infh>; defined $data and $self->_multiplex_input($data); $data; } } sub GETC { my $self = shift; my $data = getc($self->[0]); defined $data and $self->_multiplex_input($data); $data; } sub sysread { my $self = shift; my $bytes = ${*$self}[0]->sysread(@_); $bytes and (\@{*$self})-> _multiplex_input(substr($_[0], $_[2] || 0, $bytes)); $bytes; } sub EOF { my $self = shift; return $self->[0]->eof; } 1; __END__ =head1 NAME IO::Tee - Multiplex output to multiple output handles =head1 SYNOPSIS use IO::Tee; $tee = IO::Tee->new($handle1, $handle2); print $tee "foo", "bar"; my $input = <$tee>; =head1 DESCRIPTION C objects can be used to multiplex input and output in two different ways. The first way is to multiplex output to zero or more output handles. The C constructor, given a list of output handles, returns a tied handle that can be written to. When written to (using print or printf), the C object multiplexes the output to the list of handles originally passed to the constructor. As a shortcut, you can also directly pass a string or an array reference to the constructor, in which case C is called for you with the specified argument or arguments. The second way is to multiplex input from one input handle to zero or more output handles as it is being read. The C constructor, given an input handle followed by a list of output handles, returns a tied handle that can be read from as well as written to. When written to, the C object multiplexes the output to all handles passed to the constructor, as described in the previous paragraph. When read from, the C object reads from the input handle given as the first argument to the C constructor, then writes any data read to the output handles given as the remaining arguments to the constructor. The C class supports certain C and C methods related to input and output. In particular, the following methods will iterate themselves over all handles associated with the C object, and return TRUE indicating success if and only if all associated handles returned TRUE indicating success: =over 4 =item close =item truncate =item write =item syswrite =item format_write =item formline =item fcntl =item ioctl =item flush =item clearerr =item seek =back The following methods perform input multiplexing as described above: =over 4 =item read =item sysread =item readline =item getc =item gets =item eof =item getline =item getlines =back The following methods can be used to set (but not retrieve) the current values of output-related state variables on all associated handles: =over 4 =item autoflush =item output_field_separator =item output_record_separator =item format_page_number =item format_lines_per_page =item format_lines_left =item format_name =item format_top_name =item format_line_break_characters =item format_formfeed =back The following methods are directly passed on to the input handle given as the first argument to the C constructor: =over 4 =item input_record_separator =item input_line_number =back Note that the return value of input multiplexing methods (such as C) is always the return value of the input action, not the return value of subsequent output actions. In particular, no error is indicated by the return value if the input action itself succeeds but subsequent output multiplexing fails. =head1 EXAMPLE use IO::Tee; use IO::File; my $tee = new IO::Tee(\*STDOUT, new IO::File(">tt1.out"), ">tt2.out"); print join(' ', $tee->handles), "\n"; for (1..10) { print $tee $_, "\n" } for (1..10) { $tee->print($_, "\n") } $tee->flush; $tee = new IO::Tee('; print scalar(@lines); =head1 AUTHOR Chung-chieh Shan, ken@digitas.harvard.edu =head1 COPYRIGHT Copyright (c) 1998-2001 Chung-chieh Shan. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L. =cut IO-Tee-0.64/Changes0100644001356100135600000000237107252533371012315 0ustar kenuserRevision history for Perl module IO::Tee. 0.01 1997-07-24 - Original version; created by h2xs 1.18. 0.50 1997-07-24 - First release. 0.60 1998-03-04 - Added a bunch of proxy methods; the object returned by new() is a glob ref to a tied handle whose associated object is an array ref which is the same array ref as is obtained by casting the glob ref to an array ref. 0.61 1998-04-11 - Added handling of input handles. (Thanks to Jochen Wiedmann) 0.62 1998-04-20 - Fixed the "untie attempted" warning when destroying IO::Tee objects with warnings on. (Thanks to Jochen Wiedmann) Also fixed the "use of uninitialized value" warning when calling IO::Tee::sysread with the offset argument omitted. 0.63 1998-11-06 - Fixed test.pl problem on Win32 -- files need to be closed before being unlinked. (Thanks to Mike Blazer) 0.64 2001-03-10 - Fixed: output_field_separator, output_record_separator, input_record_separator, format_line_break_characters, and format_formfeed are not supported on a per-handle basis - Applied long overdue patch to make IO::Tee work with Perl 5.6. (Thanks to Tim Jenness) IO-Tee-0.64/test.pl0100644001356100135600000000625607252532766012353 0ustar kenuser# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' use strict; BEGIN { $^W = 1 } ######################### We start with some black magic to print on failure. my $loaded; BEGIN { $| = 1; print "1..27\n"; } END {print "not ok 1\n" unless $loaded;} use IO::Tee; use IO::File; $loaded = 1; print "ok 1\n"; ######################### End of black magic. my $testfile1 = IO::File->new('>test.1'); open TEST3, '>test.3' and $testfile1 and print "ok 2\n" or print "not ok 2\n"; { my $tee = IO::Tee->new(\*STDOUT, $testfile1); undef $testfile1; print $tee "ok 3\n" and print "ok 4\n" or print "not ok 3\nnot ok 4\n"; printf $tee "ok %d\n", 5 and print "ok 6\n" or print "not ok 5\nnot ok 6\n"; $tee->print ("ok 7\n" ) and print "ok 8\n" or print "not ok 7\nnot ok 8\n"; $tee->printf("ok %d\n", 9 ) and print "ok 10\n" or print "not ok 9\nnot ok 10\n"; } { my $t1 = IO::Tee->new(['>test.2'], \*TEST3); my $t2 = IO::Tee->new(\*STDOUT, $t1); $testfile1 = IO::File->new(') eq "ok 3\nok 5\nok 7\nok 9\n") { $t2->print("ok 11\n") and print "ok 12\n" or print "not ok 12\n"; } else { $t2->print("not ok 11\n") and print "ok 12\n" or print "not ok 12\n"; } undef $testfile1; } IO::Tee->new->print('123') and print "ok 13\n" or print "not ok 13\n"; my $testfile2; close TEST3 and $testfile2 = IO::File->new(') eq "ok 11\n" and join('', ) eq "ok 11\n" and print "ok 14\n" or print "not ok 14\n"; my $t3 = IO::Tee->new(\*STDOUT, ['>test.4']); $t3 and ($t3->autoflush(1), $t3->flush) and print "ok 15\n" or print "not ok 15\n"; { my $t5 = IO::File->new('new('>test.5'); print(($t6 ? '' : 'not '), "ok 17\n"); my $t7 = IO::Tee->new($t5, $t6); print(($t7 ? '' : 'not '), "ok 18\n"); my $char = $t7->getc(); print(($char eq 'o' ? '' : 'not '), "ok 19\n"); my $line1 = $t7->getline(); print(($line1 eq "k 3\n" ? '' : 'not '), "ok 20\n"); #print(($t7->input_record_separator(' ') eq "\n" ? '' : 'not '), "ok 21\n"); print((ref($t7)->input_record_separator(' ') eq "\n" ? '' : 'not '), "ok 21\n"); my $line2 = $t7->getline(); print(($line2 eq 'ok ' ? '' : 'not '), "ok 22\n"); my $block; my $result = $t7->read($block, 4000); print(($block eq "5\nok 7\nok 9\n" ? '' : 'not '), "ok 23\n"); print(($t7->eof ? '' : 'not '), "ok 24\n"); $t7->close; my $expected = $char . $line1 . $line2 . $block; my $t8 = IO::File->new('getlines); print((($contents eq $expected) ? '' : 'not '), "ok 25\n"); $t8 = IO::File->new('new($t8); $contents = ''; $result = $t7->sysread($contents, 4000); print((($contents eq $expected) ? '' : 'not '), "ok 26\n"); } undef $testfile2; close TEST3; undef $t3; 5 == unlink 'test.1', 'test.2', 'test.3', 'test.4', 'test.5' and print "ok 27\n" or print "not ok 27\n"; IO-Tee-0.64/README0100644001356100135600000000414307252532425011700 0ustar kenuserNAME IO::Tee - Multiplex output to multiple output handles SYNOPSIS use IO::Tee; $tee = IO::Tee->new($handle1, $handle2); print $tee "foo", "bar"; DESCRIPTION The `IO::Tee' constructor, given a list of output handles, returns a tied handle that can be written to but not read from. When written to (using print or printf), it multiplexes the output to the list of handles originally passed to the constructor. As a shortcut, you can also directly pass a string or an array reference to the constructor, in which case `IO::File::new' is called for you with the specified argument or arguments. The `IO::Tee' class supports certain `IO::Handle' and `IO::File' methods related to output. In particular, the following methods will iterate themselves over all handles associated with the `IO::Tee' object, and return TRUE indicating success if and only if all associated handles returned TRUE indicating success: close truncate write syswrite format_write formline fcntl ioctl flush clearerr seek Additionally, the following methods can be used to set (but not retrieve) the current values of output-related state variables on all associated handles: autoflush output_field_separator output_record_separator format_page_number format_lines_per_page format_lines_left format_name format_top_name format_line_break_characters format_formfeed EXAMPLE use IO::Tee; use IO::File; my $tee = new IO::Tee(\*STDOUT, new IO::File(">tt1.out"), ">tt2.out"); print join(' ', $tee->handles), "\n"; for (1..10) { print $tee $_, "\n" } for (1..10) { $tee->print($_, "\n") } $tee->flush; AUTHOR Chung-chieh Shan, ken@digitas.harvard.edu COPYRIGHT Copyright (c) 1998-2001 Chung-chieh Shan. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. SEE ALSO the perlfunc manpage, the IO::Handle manpage, the IO::File manpage. IO-Tee-0.64/MANIFEST0100644001356100135600000000006306366023537012152 0ustar kenuserChanges MANIFEST Makefile.PL README Tee.pm test.pl