r18887 - in /branches/upstream/libio-tee-perl: ./ current/ current/Changes current/MANIFEST current/Makefile.PL current/README current/Tee.pm current/test.pl
yvesago-guest at users.alioth.debian.org
yvesago-guest at users.alioth.debian.org
Sun Apr 20 11:02:04 UTC 2008
Author: yvesago-guest
Date: Sun Apr 20 11:02:03 2008
New Revision: 18887
URL: http://svn.debian.org/wsvn/?sc=1&rev=18887
Log:
[svn-inject] Installing original source of libio-tee-perl
Added:
branches/upstream/libio-tee-perl/
branches/upstream/libio-tee-perl/current/
branches/upstream/libio-tee-perl/current/Changes
branches/upstream/libio-tee-perl/current/MANIFEST
branches/upstream/libio-tee-perl/current/Makefile.PL
branches/upstream/libio-tee-perl/current/README
branches/upstream/libio-tee-perl/current/Tee.pm
branches/upstream/libio-tee-perl/current/test.pl
Added: branches/upstream/libio-tee-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/Changes?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/Changes (added)
+++ branches/upstream/libio-tee-perl/current/Changes Sun Apr 20 11:02:03 2008
@@ -1,0 +1,33 @@
+Revision 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)
Added: branches/upstream/libio-tee-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/MANIFEST?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/MANIFEST (added)
+++ branches/upstream/libio-tee-perl/current/MANIFEST Sun Apr 20 11:02:03 2008
@@ -1,0 +1,6 @@
+Changes
+MANIFEST
+Makefile.PL
+README
+Tee.pm
+test.pl
Added: branches/upstream/libio-tee-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/Makefile.PL?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/Makefile.PL (added)
+++ branches/upstream/libio-tee-perl/current/Makefile.PL Sun Apr 20 11:02:03 2008
@@ -1,0 +1,10 @@
+use 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' },
+);
Added: branches/upstream/libio-tee-perl/current/README
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/README?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/README (added)
+++ branches/upstream/libio-tee-perl/current/README Sun Apr 20 11:02:03 2008
@@ -1,0 +1,73 @@
+NAME
+ 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 at 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.
+
Added: branches/upstream/libio-tee-perl/current/Tee.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/Tee.pm?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/Tee.pm (added)
+++ branches/upstream/libio-tee-perl/current/Tee.pm Sun Apr 20 11:02:03 2008
@@ -1,0 +1,379 @@
+package 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';
+ at 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<IO::Tee> 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<IO::Tee> 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<IO::Tee> 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<IO::File::new> 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<IO::Tee> 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<IO::Tee> object multiplexes the output to all handles passed
+to the constructor, as described in the previous paragraph. When read
+from, the C<IO::Tee> object reads from the input handle given as the
+first argument to the C<IO::Tee> constructor, then writes any data
+read to the output handles given as the remaining arguments to the
+constructor.
+
+The C<IO::Tee> class supports certain C<IO::Handle> and C<IO::File>
+methods related to input and output. In particular, the following
+methods will iterate themselves over all handles associated with the
+C<IO::Tee> 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<IO::Tee> constructor:
+
+=over 4
+
+=item input_record_separator
+
+=item input_line_number
+
+=back
+
+Note that the return value of input multiplexing methods (such as
+C<print>) 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('</etc/passwd', \*STDOUT);
+ my @lines = <$tee>;
+ print scalar(@lines);
+
+=head1 AUTHOR
+
+Chung-chieh Shan, ken at 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<perlfunc>, L<IO::Handle>, L<IO::File>.
+
+=cut
Added: branches/upstream/libio-tee-perl/current/test.pl
URL: http://svn.debian.org/wsvn/branches/upstream/libio-tee-perl/current/test.pl?rev=18887&op=file
==============================================================================
--- branches/upstream/libio-tee-perl/current/test.pl (added)
+++ branches/upstream/libio-tee-perl/current/test.pl Sun Apr 20 11:02:03 2008
@@ -1,0 +1,97 @@
+# 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('<test.1');
+ if (join('', <$testfile1>) 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('<test.2')
+ and open TEST3, '<test.3'
+ and join('', <$testfile2>) eq "ok 11\n"
+ and join('', <TEST3>) 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('<test.1');
+ print(($t5 ? '' : 'not '), "ok 16\n");
+ my $t6 = IO::File->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('<test.5');
+ my $contents = join('', $t8->getlines);
+ print((($contents eq $expected) ? '' : 'not '), "ok 25\n");
+
+ $t8 = IO::File->new('<test.5');
+ $t7 = IO::Tee->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";
More information about the Pkg-perl-cvs-commits
mailing list