r1788 - in packages: . libio-capture-perl
libio-capture-perl/branches libio-capture-perl/branches/upstream
libio-capture-perl/branches/upstream/current
libio-capture-perl/branches/upstream/current/lib
libio-capture-perl/branches/upstream/current/lib/IO
libio-capture-perl/branches/upstream/current/lib/IO/Capture
libio-capture-perl/branches/upstream/current/t
Krzysztof Krzyzaniak
eloy at costa.debian.org
Wed Dec 28 14:21:53 UTC 2005
Author: eloy
Date: 2005-12-28 14:21:11 +0000 (Wed, 28 Dec 2005)
New Revision: 1788
Added:
packages/libio-capture-perl/
packages/libio-capture-perl/branches/
packages/libio-capture-perl/branches/upstream/
packages/libio-capture-perl/branches/upstream/current/
packages/libio-capture-perl/branches/upstream/current/BUGS
packages/libio-capture-perl/branches/upstream/current/Changes
packages/libio-capture-perl/branches/upstream/current/MANIFEST
packages/libio-capture-perl/branches/upstream/current/META.yml
packages/libio-capture-perl/branches/upstream/current/Makefile.PL
packages/libio-capture-perl/branches/upstream/current/README
packages/libio-capture-perl/branches/upstream/current/lib/
packages/libio-capture-perl/branches/upstream/current/lib/IO/
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture.pm
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Overview.pod
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stderr.pm
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stdout.pm
packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Tie_STDx.pm
packages/libio-capture-perl/branches/upstream/current/t/
packages/libio-capture-perl/branches/upstream/current/t/01_1_Published_Methods.t
packages/libio-capture-perl/branches/upstream/current/t/01_2_Published_Methods_Stdout.t
packages/libio-capture-perl/branches/upstream/current/t/01_3_Published_Methods_Stderr.t
packages/libio-capture-perl/branches/upstream/current/t/02_1_basic_base.t
packages/libio-capture-perl/branches/upstream/current/t/02_2_basic_Stdout.t
packages/libio-capture-perl/branches/upstream/current/t/02_3_basic_Stderr.t
packages/libio-capture-perl/branches/upstream/current/t/03_1_Errorcheck_Stdout.t
packages/libio-capture-perl/branches/upstream/current/t/03_2_Errorcheck_Stderr.t
packages/libio-capture-perl/branches/upstream/current/t/04_1_Side-effects_base.t
packages/libio-capture-perl/branches/upstream/current/t/04_2_Side-effects_Stdout.t
packages/libio-capture-perl/branches/upstream/current/t/04_3_Side-effects_Stderr.t
packages/libio-capture-perl/branches/upstream/current/t/05_2_regression.t
packages/libio-capture-perl/branches/upstream/current/t/06_2_printf_Stdout.t
packages/libio-capture-perl/branches/upstream/current/t/06_3_printf_Stderr.t
packages/libio-capture-perl/branches/upstream/current/t/06_printf_stdout.t
packages/libio-capture-perl/branches/upstream/current/t/07_3_warn_Stderr.t
packages/libio-capture-perl/tags/
Log:
[svn-inject] Installing original source of libio-capture-perl
Added: packages/libio-capture-perl/branches/upstream/current/BUGS
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/BUGS 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/BUGS 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,22 @@
+Bug list for IO::Capture
+
+1) Complains to STDERR if nothing captured
+ Thanks to Robb Canfield for the report
+ Fixed in 0.02
+2) Documentation error
+ Thanks to Mike Castle
+ Fixed in .03
+3) Line pointer wrong if read() is called in scalar context,
+ then called a 2nd time in scalar.
+4) rt.cpan.org bug numbers 9483, and 7261. printf not working
+ Fixed in .04
+5) IO::Capture::Stderr will capture messages from warn() in Perl
+ 5.8 and higher, but not in lower than 5.8. (This was the
+ reason I added IO::Capture::ErrorMessages at the beginning.)
+ Added a check and do:
+
+ $SIG{__WARN__} = sub {print STDERR @_;}
+
+6) If $SIG{__WARN__} has a handler set by the program, in versions
+ older that 5.8, the IO::Capture::Stderr will capture warn() text
+ even without FORCE_CAPTURE_WARN being set. Fixed in Version 0.05
Added: packages/libio-capture-perl/branches/upstream/current/Changes
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/Changes 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/Changes 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,31 @@
+Revision history for Perl extension Capture.
+
+0.01 Wed Mar 12 15:11:37 2003
+
+ - original version; created by h2xs 1.1
+
+0.02 Sat Dec 20 08:23:00 EST 2003
+
+ - Fixed bug that caused messages to be printed if nothing was captured.
+ Thanks to Robb Canfield.
+ - Some changes to documentation
+
+0.04 Apr 29 13:18:39 EDT 2005
+
+ I found a couple of problems that made me re-think the module
+ IO::Capture::ErrorMessages. As a result, I am removing this
+ module from the distribution. It is now depreciated and will
+ be remove in the next release. IO::Capture::Stderr now has
+ has the same functionality that IO::Capture::Stderr did previously,
+ and can be used instead.
+
+ I have changed the base class so that you can now pass arguments
+ to derived classes.
+
+ I have added a new parameter to IO::Capture::Stderr, "FORCE_CAPTURE_WARN".
+ It controls capturing text sent via warn(), if $SIG{__WARN__} has been
+ changed. The default is to let the text go to the handler set in
+ $SIG{__WARN__}. If you want to override this, set FORCE_CAPTURE_WARN
+ to a 1.
+
+
Added: packages/libio-capture-perl/branches/upstream/current/MANIFEST
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/MANIFEST 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/MANIFEST 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,27 @@
+README
+BUGS
+Changes
+MANIFEST
+Makefile.PL
+lib/IO/Capture.pm
+lib/IO/Capture/Stdout.pm
+lib/IO/Capture/Stderr.pm
+lib/IO/Capture/Tie_STDx.pm
+lib/IO/Capture/Overview.pod
+t/01_1_Published_Methods.t
+t/01_2_Published_Methods_Stdout.t
+t/01_3_Published_Methods_Stderr.t
+t/02_1_basic_base.t
+t/02_2_basic_Stdout.t
+t/02_3_basic_Stderr.t
+t/03_1_Errorcheck_Stdout.t
+t/03_2_Errorcheck_Stderr.t
+t/04_1_Side-effects_base.t
+t/04_2_Side-effects_Stdout.t
+t/04_3_Side-effects_Stderr.t
+t/05_2_regression.t
+t/06_2_printf_Stdout.t
+t/06_3_printf_Stderr.t
+t/06_printf_stdout.t
+t/07_3_warn_Stderr.t
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libio-capture-perl/branches/upstream/current/META.yml
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/META.yml 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/META.yml 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,12 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: IO-Capture
+version: 0.04
+version_from: lib/IO/Capture.pm
+installdirs: site
+requires:
+ Carp: 0
+ Test::More: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.17
Added: packages/libio-capture-perl/branches/upstream/current/Makefile.PL
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/Makefile.PL 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/Makefile.PL 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,10 @@
+use 5.006;
+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::Capture',
+ VERSION_FROM => 'lib/IO/Capture.pm', # finds $VERSION
+ PREREQ_PM => {Carp => 0, Test::More => 0},
+);
+
Added: packages/libio-capture-perl/branches/upstream/current/README
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/README 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/README 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,34 @@
+ IO::Capture
+
+ The IO::Capture Module defines an abstract base class that can be
+used to create any number of useful sub-classes that capture output
+being sent on a filehandle such as STDOUT or STDERR.
+ Several modules come with the distribution that define sub-
+classes of IO::Capture to do just that. (I.e., capture STDOUT and STDERR)
+See the man page IO::Capture::Overview for a discussion of these
+modules and how to build a module to sub-class the B<IO::Capture>
+class yourself.
+ To build and install this module, follow the standard procedures:
+
+ $ perl Makefile.PL
+ $ make
+ $ make test
+ $ su
+ # make install
+
+
+Report any problems via http://rt.cpan.org/.
+
+CHANGES:
+ I found a couple of problems that made me re-think the module
+ IO::Capture::ErrorMessages. As a result, I am removing this
+ module from the distribution. It is now depreciated and will
+ be remove in the next release. IO::Capture::Stderr now has
+ has the same functionality that IO::Capture::Stderr did previously,
+ and can be used instead.
+
+ I have added a new parameter to IO::Capture::Stderr, "FORCE_CAPTURE_WARN".
+ It controls capturing text sent via warn(), if $SIG{__WARN__} has been
+ changed. The default is to let the text go to the handler set in
+ $SIG{__WARN__}. If you want to override this, set FORCE_CAPTURE_WARN
+ to a 1.
Added: packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Overview.pod
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Overview.pod 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Overview.pod 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,218 @@
+=head1 NAME
+
+Overview of C<IO::Capture> Module, and classes derived from it.
+
+=head1 DESCRIPTION
+
+The modules in this distribution are designed to allow you to
+capture and process output sent to STDOUT and/or STDERR.
+
+I initial created the modules to use in building module tests. I
+wanted to be able to intentionally cause errors, and insure the
+module responded correctly. E.g., Call a class method without a
+required argument. Using IO::Capture keeps the user from seeing
+these intentional errors when running 'make test'.
+
+I have also found this useful on occasion in Perl Tk apps, where
+I wanted to capture output from a Perl module I was using. I could
+then capture, then put the text into a log or message window.
+
+Note: None of the modules currently distributed will capture from
+the 'system' Perl function, or the like. It could be done, but
+generally, if you would like to capture from a system command,
+you don't need this module, just use the backticks operators.
+
+ my $output = '/usr/bin/ls';
+
+
+They are small, lightweight modules. Instead of designing in a lot of
+features, we designed it to be easily reusable and adaptable.
+A module can be quickly built, that incorporates custom methods, but
+reuses all existing features of one of the derived classes. See the
+section on L<"ADDING FEATURES"> Or, if you need to change the actual
+capture mechanism, L<"WRITING YOUR OWN DERIVED CLASS">. (Don't worry,
+it's a piece of cake)
+
+=head1 DERIVED CLASSES
+
+There are several classes derived from C<IO::Capture>.
+
+=head2 IO::Capture::Stdout
+
+Module to capture C<STDOUT> from program. See L<IO::Capture::Stdout>.
+
+=head2 IO::Capture::Stderr
+
+Module to capture C<STDERR> from program. See L<IO::Capture::Stderr>.
+
+=head2 IO::Capture::ErrorMessages
+
+This method has been depreciated. The only difference between this one and Stderr.pm
+was the trap for WARN. I found it was fixed in 5.8 so just check in Stderr
+now. I.e., Just use Stderr now. It (Stderr) will detect what version of
+perl you are using, and act accordingly. The two (C<IO::Capture::ErrorMessages> and
+C<IO::Capture::Stderr>) are currently identical, and C<IO::Capture::ErrorMessages> will
+be removed in a future release.
+
+If you would like to add features to any of these, or build your
+own module using C<IO::Capture> as a base, read on.
+
+=head1 ADDING FEATURES
+
+If one of these modules takes care of your problem, install it and
+have fun!
+
+But let's say you would like to add a feature to one of the derived classes,
+say IO::Capture::Stdout. No need to re-write the whole module, just use it
+as the base, and write your one feature. Here is a somewhat simplified
+example.
+
+ #
+ # Example module to add a grep_it method
+ #
+ # Give your package a name
+ package MyPackage;
+
+ #use IO:Capture:Stdout as the base
+ use base 'IO::Capture::Stdout';
+
+ #define your method
+ sub grep_it {
+ my $self = shift;
+ my $string = shift;
+ my @found_lines;
+
+ # Making a ref to the array makes it easier to read :-)
+ my $arrayref = \@{$self->{'IO::Capture::messages'}};
+
+ for my $line (@$arrayref) {
+ push @found_lines, $line if $line =~ /$string/;
+ }
+ return wantarray ? @found_lines : scalar(@found_lines);
+ }
+ 1;
+
+Using it in this script
+
+ #!/usr/sbin/perl
+ use strict;
+ use warnings;
+ use MyPackage;
+
+ my $capture = MyPackage->new();
+ $capture->start;
+ print "The quick brown fox jumped over ...";
+ print "garden wall";
+ print "The quick red fox jumped over ...";
+ print "garden wall";
+ $capture->stop;
+ for my $line ($capture->grep_it("fox")) {
+ print "$line\n";
+ }
+
+Results in
+
+ $ grep_it
+ The quick brown fox jumped over ...
+ The quick red fox jumped over ...
+
+=head1 WRITING YOUR OWN DERIVED CLASS
+
+Before starting your own sub-class, be sure to read through L<IO::Capture>. Pay
+special attention to the internal methods that are only defined as I<abstract>
+methods in C<IO::Capture>. For examples, look at the sub-classes included with
+this distribution. (C<IO::Capture::Stdout>, C<IO:Capture::Stderr>.
+You can start by copying one of these and using
+it as a template. They have the required private methods defined already, and you
+may very well be able to use them as is. Change any methods, and add any new
+ones, as needed.
+
+For example, here is a commented copy of C<IO::Capture::Stderr>.
+
+ #
+ # Example module using abstract class IO::Capture
+ #
+ # Change this to give your class it's own name
+ package IO::Capture::Stderr;
+
+ # Make IO::Capture the base class
+ use base qw/IO::Capture/;
+
+ # If using included utility module in '_start()'
+ use IO::Capture::Tie_STDx;
+
+ # Override the three abstract methods needed to make a valid
+ # module. See IO::Capture manpage
+ # 1) _start - Starts the data capture. Is run from public method
+ # start();
+ #
+ # 2) _retrieve_captured_text() - Move the captured text into the
+ # object hash key, "IO::Capture::messages". Called by public method
+ #
+ # 3) _stop - Stop the data capture. Called by public method 'stop()'
+ # after private method '_retrieve_captured_text()' returns.
+ #
+ sub _start {
+ tie *STDERR, "IO::Capture::Tie_STDx";
+ }
+
+ sub _retrieve_captured_text {
+ my $self = shift;
+ # making a reference to it makes it more readable ;-)
+ my $messages = \@{$self->{'IO::Capture::messages'}};
+
+ @$messages = <STDERR>;
+ }
+
+ sub _stop {
+ untie *STDERR;
+ return 1;
+ }
+ 1;
+
+Lets say you don't want to capture B<all> the text. You just want to
+grab the lines that have the word "Error" in them. The only thing you
+need to change is _retrieve_captured_text. (Besides the package name)
+
+Something like:
+
+ sub _retrieve_captured_text {
+ my $self = shift;
+ # making a reference to it makes it more readable ;-)
+ my $messages = \@{$self->{'IO::Capture::messages'}};
+
+ while (<STDERR>) {
+ push @$messages, $_ if /error/i;
+ }
+ }
+
+Yes. You could do this easier by just using C<IO::Capture::Stderr> as the base and
+overriding C<_retrieve_captured_text> like in L<"ADDING FEATURES">, but hey, we
+needed an easy example. :-)
+
+If you want your class to have arguments that users can pass in, just use the default
+C<new()> method and have the arguments passed in as an anonymous array. See the
+C<IO::Capture::Stderr> module for an example.
+
+=head1 BUGS
+
+Please report bugs on http://rt.cpan.org/
+
+=head1 CREDITS
+
+Special thanks to James E Keenan for many bug fixes and tests he provided.
+
+=head1 AUTHOR
+
+Mark Reynolds
+reynolds<at>sgi.com
+
+Note: C<Change <at> to 'at' sign.>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003-2005, Mark Reynolds. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as Perl itself.
+
+=cut
Added: packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stderr.pm
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stderr.pm 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stderr.pm 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,380 @@
+package IO::Capture::Stderr;
+use strict;
+use warnings;
+use Carp;
+use base qw/IO::Capture/;
+use IO::Capture::Tie_STDx;
+
+sub _start {
+ my $self = shift;
+ $self->line_pointer(1);
+
+ if ( _capture_warn_check() ) {
+ $self->{'IO::Capture::handler_save'} = defined $SIG{__WARN__} ? $SIG{__WARN__} : 'DEFAULT';
+ $SIG{__WARN__} = sub {print STDERR @_;};
+ }
+ else {
+ $self->{'IO::Capture::handler_save'} = undef;
+ }
+ tie *STDERR, "IO::Capture::Tie_STDx";
+}
+
+sub _retrieve_captured_text {
+ my $self = shift;
+ my $messages = \@{$self->{'IO::Capture::messages'}};
+
+ @$messages = <STDERR>;
+ return 1;
+}
+
+sub _check_pre_conditions {
+ my $self = shift;
+
+ return unless $self->SUPER::_check_pre_conditions;
+
+ if (tied *STDERR) {
+ carp "WARNING: STDERR already tied, unable to capture";
+ return;
+ }
+ return 1;
+}
+
+sub _stop {
+ my $self = shift;
+ untie *STDERR;
+ $SIG{__WARN__} = $self->{'IO::Capture::handler_save'} if defined $self->{'IO::Capture::handler_save'};
+ return 1;
+}
+
+# _capture_warn_check
+#
+# Check to see if SIG{__WARN__} handler should be set to direct output
+# from warn() to IO::Capture::Stderr.
+# There are three things to take into consideration.
+#
+# 1) Is the version of perl less than 5.8?
+# - Before 5.8, there was a bug that caused output from warn()
+# not to be sent to STDERR if it (STDERR) was tied.
+# So, we need to put a handler in to send warn() text to
+# STDERR so IO::Capture::Stderr will capture it.
+# 2) Is there a handler set already?
+# - The default handler for SIG{__WARN__} is to send to STDERR.
+# But, if it is set by the program, it may do otherwise, and
+# we don't want to break that.
+# 3) FORCE_CAPTURE_WARN => 1
+# - To allow users to override a previous handler that was set on
+# SIG{__WARN__}, there is a variable that can be set. If set,
+# when there is a handler set on IO::Capture::Stderr startup,
+# it will be saved and a new hander set that captures output to
+# IO::Capture::Stderr. On stop, it will restore the programs
+# handler.
+#
+#
+#
+# Perl | FORCE_CAPTURE_WARN | Program has | Set our own
+# < 5.8 | is set | handler set | handler
+# --------+----------------------+----------------+------------
+# | | |
+# --------+----------------------+----------------+------------
+# X | | | X (1)
+# --------+----------------------+----------------+------------
+# | X | |
+# --------+----------------------+----------------+------------
+# X | X | | X (1)
+# --------+----------------------+----------------+------------
+# | | X |
+# --------+----------------------+----------------+------------
+# X | | X |
+# --------+----------------------+----------------+------------
+# | X | X | X (2)
+# --------+----------------------+----------------+------------
+# X | X | X | X (2)
+# --------+----------------------+----------------+------------
+# (1) WAR to get around bug
+# (2) Replace programs handler with our own
+
+sub _capture_warn_check {
+ my $self = shift;
+
+ if (!defined $SIG{__WARN__} ) {
+ return $^V lt v5.8 ? 1 : 0;
+ }
+ return $self->{'FORCE_CAPTURE_WARN'} ? 1 : 0;
+}
+1;
+
+__END__
+
+=head1 NAME
+
+C<IO::Capture::Stderr> - Capture all output sent to C<STDERR>
+
+=head1 SYNOPSIS
+
+ use IO::Capture::Stderr;
+
+ $capture = IO::Capture::Stderr->new();
+
+ $capture->start(); # STDERR Output captured
+ print STDERR "Test Line One\n";
+ print STDERR "Test Line Two\n";
+ print STDERR "Test Line Three\n";
+ $capture->stop(); # STDERR output sent to wherever it was before 'start'
+
+ # In 'scalar context' returns next line
+ $line = $capture->read;
+ print "$line"; # prints "Test Line One"
+
+ $line = $capture->read;
+ print "$line"; # prints "Test Line Two"
+
+ # move line pointer to line 1
+ $capture->line_pointer(1);
+
+ $line = $capture->read;
+ print "$line"; # prints "Test Line One"
+
+ # Find out current line number
+ $current_line_position = $capture->line_pointer;
+
+ # In 'List Context' return an array(list)
+ @all_lines = $capture->read;
+
+ # Example 1 - "Using in module tests"
+ # Note: If you don't want to make users install
+ # the IO::Capture module just for your tests,
+ # you can just install in the t/lib directory
+ # of your module and use the lib pragma in
+ # your tests.
+
+ use lib "t/lib";
+ use IO::Capture:Stderr;
+
+ use Test::More;
+
+ # Create new capture object. Showing FORCE_CAPTURE_WARN being cleared
+ # for example, but 0 is the default, so you don't need to specify
+ # unless you want to set.
+ my $capture = IO::Capture:Stderr->new( {FORCE_CAPTURE_WARN => 0} );
+ $capture->start
+
+ # execute with a bad parameter to make sure get
+ # an error.
+
+ ok( ! $test("Bad Parameter") );
+
+ $capture->stop();
+
+
+
+=head1 DESCRIPTION
+
+The module C<IO::Capture::Stderr>, is derived from the abstract class C<IO::Capture>.
+See L<IO::Capture>. The purpose of the module (as the name suggests) is to capture
+any output sent to C<STDOUT>. After the capture is stopped, the STDOUT filehandle
+will be reset to the previous location. E.g., If previously redirected to a file, when
+C<IO::Capture-E<gt>stop> is called, output will start going into that file again.
+
+Note: This module won't work with the perl function, system(), or any other operation
+ involving a fork(). If you want to capture the output from a system command,
+ it is faster to use open() or back-ticks.
+
+ my $output = `/usr/sbin/ls -l 2>&1`;
+
+=head1 METHODS
+
+=head2 new
+
+=over 4
+
+=item *
+
+Creates a new capture object.
+
+=item *
+
+An object can be reused as needed, so will only need to do one of these.
+
+=over 4
+
+=item *
+
+Be aware, any data previously captured will be discarded if a new
+capture session is started.
+
+=back
+
+=back
+
+=head2 start
+
+=over 4
+
+=item *
+
+Start capturing data into the C<IO::Capture> Object.
+
+=item *
+
+Can B<not> be called on an object that is already capturing.
+
+=item *
+
+Can B<not> be called while STDERR tied to an object.
+
+=item *
+
+C<undef> will be returned on an error.
+
+=back
+
+=head2 stop
+
+=over 4
+
+=item *
+
+Stop capturing data and point STDERR back to it's previous output location
+I.e., untie STDERR
+
+=back
+
+=head2 read
+
+=over 4
+
+=item *
+
+In I<Scalar Context>
+
+=over 4
+
+=item *
+
+Lines are read from the buffer at the position of the C<line_pointer>,
+and the pointer is incremented by one.
+
+ $next_line = $capture->read;
+
+=back
+
+=item *
+
+In I<List Context>
+
+=over 4
+
+=item *
+
+The array is returned. The C<line_pointer> is not affected.
+
+ @buffer = $capture->read;
+
+=back
+
+=item *
+
+Data lines are returned exactly as they were captured. You may want
+to use C<chomp> on them if you don't want the end of line character(s)
+
+ while (my $line = $capture->read) {
+ chomp $line;
+ $cat_line = join '', $cat_line, $line;
+ }
+
+=back
+
+=head2 line_pointer
+
+=over 4
+
+=item *
+
+Reads or sets the C<line_pointer>.
+
+ my $current_line = $capture->line_pointer;
+ $capture->line_pointer(1);
+
+=back
+
+=head1 ARGUMENTS
+
+Pass any arguments to new() in a single array reference.
+
+ IO::Capture::Stderr->new( {FORCE_CAPTURE_WARN => 1} );
+
+=head2 FORCE_CAPTURE_WARN
+
+=over 4
+
+
+Normally, IO::Capture::Stderr will capture text from I<warn()> function calls. This is because output
+from I<warn()> is normally directed to STDERR. If you wish to force IO::Capture::Stderr to grab the
+text from I<warn()>, set FORCE_CAPTURE_WARN to a 1. Then C<IO::Capture::Stderr> will save the handle
+that C<$SIG{__WARN__}> was set to, redirect it to itself on C<start()>, and then set C<$SIG{__WARN__}>
+back after C<stop()> is called.
+
+=back
+
+=head1 SUB-CLASSING
+
+=head2 Adding Features
+
+If you would like to sub-class this module to add a feature (method) or two,
+here is a couple of easy steps. Also see L<IO::Capture::Overview>.
+
+=over 4
+
+=item 1
+
+Give your package a name
+
+ package MyPackage;
+
+=item 2
+
+Use this C<IO::Capture::Stderr> as your base class like this:
+
+ package MyPackage;
+
+ use base qw/IO::Capture::Stderr/;
+
+=item 3
+
+Add your new method like this
+
+ package MyPackage;
+
+ use base qw/IO::Capture::Stderr/;
+
+ sub grep {
+ my $self = shift;
+
+ for $line (
+ }
+
+=back
+
+=head1 See Also
+
+L<IO::Capture::Overview>
+
+L<IO::Capture>
+
+L<IO::Capture::Stdout>
+
+=head1 AUTHORS
+
+Mark Reynolds
+reynolds at sgi.com
+
+Jon Morgan
+jmorgan at sgi.com
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003, Mark Reynolds. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as Perl itself.
+
+=cut
Added: packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stdout.pm
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stdout.pm 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Stdout.pm 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,291 @@
+package IO::Capture::Stdout;
+use Carp;
+use base qw/IO::Capture/;
+use IO::Capture::Tie_STDx;
+
+sub _start {
+ my $self = shift;
+ $self->line_pointer(1);
+ tie *STDOUT, "IO::Capture::Tie_STDx";
+}
+
+sub _retrieve_captured_text {
+ my $self = shift;
+ my $messages = \@{$self->{'IO::Capture::messages'}};
+
+ @$messages = <STDOUT>;
+ #$self->line_pointer(1);
+ return 1;
+}
+
+sub _check_pre_conditions {
+ my $self = shift;
+
+ return unless $self->SUPER::_check_pre_conditions;
+
+ if (tied *STDOUT) {
+ carp "WARNING: STDOUT already tied, unable to capture";
+ return;
+ }
+ return 1;
+}
+
+sub _stop {
+ untie *STDOUT;
+}
+1;
+
+=head1 NAME
+
+IO::Capture::Stdout - Capture any output sent to STDOUT
+
+=head1 SYNOPSIS
+
+ # Generic example (Just to give the overall view)
+ use IO::Capture::Stdout;
+
+ $capture = IO::Capture::Stdout->new();
+
+ $capture->start(); # STDOUT Output captured
+ print STDOUT "Test Line One\n";
+ print STDOUT "Test Line Two\n";
+ print STDOUT "Test Line Three\n";
+ $capture->stop(); # STDOUT output sent to wherever it was before 'start'
+
+ # In 'scalar context' returns next line
+ $line = $capture->read;
+ print "$line"; # prints "Test Line One"
+
+ $line = $capture->read;
+ print "$line"; # prints "Test Line Two"
+
+ # move line pointer to line 1
+ $capture->line_pointer(1);
+
+ $line = $capture->read;
+ print "$line"; # prints "Test Line One"
+
+ # Find out current line number
+ $current_line_position = $capture->line_pointer;
+
+ # In 'List Context' return an array(list)
+ @all_lines = $capture->read;
+
+ # More useful example 1 - "Using in module tests"
+ # Note: If you don't want to make users install
+ # the IO::Capture module just for your tests,
+ # you can just install in the t/lib directory
+ # of your module and use the lib pragma in
+ # your tests.
+
+ use lib "t/lib";
+ use IO::Capture::Stdout;
+
+ use Test::More;
+
+ my $capture = IO::Capture::Stdout->new;
+ $capture->start
+
+ # execute with a bad parameter to make sure get
+ # an error.
+
+ ok( ! $test("Bad Parameter") );
+
+ $capture->stop();
+
+
+
+=head1 DESCRIPTION
+
+The module C<IO::Capture::Stdout>, is derived from the abstract class C<IO::Capture>.
+See L<IO::Capture>. The purpose of the module (as the name suggests) is to capture
+any output sent to C<STDOUT>. After the capture is stopped, the STDOUT filehandle
+will be reset to the previous location. E.g., If previously redirected to a file, when
+C<IO::Capture-E<gt>stop> is called, output will start going into that file again.
+
+Note: This module won't work with the perl function, system(), or any other operation
+ involving a fork(). If you want to capture the output from a system command,
+ it is faster to use open() or back-ticks.
+
+ my $output = `/usr/sbin/ls -l 2>&1`;
+
+
+=head1 METHODS
+
+=head2 new
+
+=over 4
+
+=item *
+
+Creates a new capture object.
+
+=item *
+
+An object can be reused as needed, so will only need to do one of these.
+
+=over 4
+
+=item *
+
+Be aware, any data previously captured will be discarded if a new
+capture session is started.
+
+=back
+
+=back
+
+=head2 start
+
+=over 4
+
+=item *
+
+Start capturing data into the C<IO::Capture> Object.
+
+=item *
+
+Can B<not> be called on an object that is already capturing.
+
+=item *
+
+Can B<not> be called while STDOUT tied to an object.
+
+=item *
+
+C<undef> will be returned on an error.
+
+=back
+
+=head2 stop
+
+=over 4
+
+=item *
+
+Stop capturing data and point STDOUT back to it's previous output location
+I.e., untie STDOUT
+
+=back
+
+=head2 read
+
+=over 4
+
+=item *
+
+In I<Scalar Context>
+
+=over 4
+
+=item *
+
+Lines are read from the buffer at the position of the C<line_pointer>,
+and the pointer is incremented by one.
+
+ $next_line = $capture->read;
+
+=back
+
+=item *
+
+In I<List Context>
+
+=over 4
+
+=item *
+
+The array is returned. The C<line_pointer> is not affected.
+
+ @buffer = $capture->read;
+
+=back
+
+=item *
+
+Data lines are returned exactly as they were captured. You may want
+to use C<chomp> on them if you don't want the end of line character(s)
+
+ while (my $line = $capture->read) {
+ chomp $line;
+ $cat_line = join '', $cat_line, $line;
+ }
+
+=back
+
+=head2 line_pointer
+
+=over 4
+
+=item *
+
+Reads or sets the C<line_pointer>.
+
+ my $current_line = $capture->line_pointer;
+ $capture->line_pointer(1);
+
+=back
+
+=head1 SUB-CLASSING
+
+=head2 Adding Features
+
+If you would like to sub-class this module to add a feature (method) or two,
+here is a couple of easy steps. Also see L<IO::Capture::Overview>.
+
+=over 4
+
+=item 1
+
+Give your package a name
+
+ package MyPackage;
+
+=item 2
+
+Use this C<IO::Capture::Stdout> as your base class like this:
+
+ package MyPackage;
+
+ use base qw/IO::Capture::Stdout/;
+
+=item 3
+
+Add your new method like this
+
+ package MyPackage;
+
+ use base qw/IO::Capture::Stdout/;
+
+ sub grep {
+ my $self = shift;
+
+ for $line (
+ }
+
+=back
+
+=head1 See Also
+
+L<IO::Capture::Overview>
+
+L<IO::Capture>
+
+L<IO::Capture::Stderr>
+
+
+=head1 AUTHORS
+
+Mark Reynolds
+reynolds at sgi.com
+
+Jon Morgan
+jmorgan at sgi.com
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003, Mark Reynolds. All Rights Reserved.
+This module is free software. It may be used, redistributed
+and/or modified under the same terms as Perl itself.
+
+=cut
Added: packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Tie_STDx.pm
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Tie_STDx.pm 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture/Tie_STDx.pm 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,49 @@
+package IO::Capture::Tie_STDx;
+
+sub TIEHANDLE {
+ my $class = shift;
+ bless [], $class;
+}
+
+sub PRINTF {
+ my $self = shift;
+ my $format = shift;
+ $self->PRINT( sprintf( $format, @_ ) );
+}
+
+sub PRINT {
+ my $self = shift;
+ push @$self, join '', at _;
+}
+
+sub READLINE {
+ my $self = shift;
+ return wantarray ? @$self : shift @$self;
+}
+
+sub CLOSE {
+ my $self = shift;
+ return close $self;
+}
+
+=head1 NAME
+
+IO::Capture::Tie_STDx;
+
+=head1 SYNOPSIS
+
+ use IO::Capture::Tie_STDx;
+ tie *STDOUT, "IO::Capture::Tie_STDx";
+
+ @$messages = <STDOUT>;
+
+ untie *STDOUT;
+
+=head1 DESCRIPTION
+
+The module C<IO::Capture::Tie_STDx> is a small utility module for use by
+C<IO::Capture> derived modules. See L<IO::Capture::Overview> It is used to tie STDOUT or STDERR.
+
+=cut
+
+1;
Added: packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture.pm
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture.pm 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/lib/IO/Capture.pm 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,409 @@
+package IO::Capture;
+
+$VERSION = 0.05;
+use strict;
+use Carp;
+
+=head1 NAME
+
+C<IO::Capture> - Abstract Base Class to build modules to capture output.
+
+=head1 DESCRIPTION
+
+The C<IO::Capture> Module defines an abstract base class that can be
+used to build modules that capture output being sent on a filehandle
+such as STDOUT or STDERR.
+
+Several modules that come with the distribution do just that.
+I.e., Capture STDOUT and STDERR. Also see James Keenan's
+C<IO::Capture::Stdout::Extended> on CPAN.
+
+See L<IO::Capture::Overview> for a
+discussion of these modules and examples of how to build a module to
+sub-class from C<IO::Capture> yourself. If after reading the overview,
+you would like to build a class from C<IO::Capture>, look here for
+details on the internals.
+
+=head1 METHODS
+
+These are the methods defined in the C<IO::Capture> Module. This page
+will be discussing the module from the point of view of someone who wants
+to build a sub-class of C<IO::Capture>.
+
+Each method defined in the C<IO::Capture> Module defines a public method,
+that then calls one or more private methods. I<(Names starting with an
+underscore)> This allows you to override methods at a finer level of
+granularity, re-using as much of the functionality provided in the module
+as possible.
+
+Of these internal methods, three are abstract methods that your will
+B<have to> override if you want your module to B<do> anything. The
+three are C<_start()>, C<_retrieve_captured_text()>. and C<_stop()>.
+
+Below are the public methods with the private methods that each uses
+immediately following.
+
+=head2 new
+
+The C<new> method creates a new C<IO::Capture> object, and returns it
+to its caller. The object is implemented with a hash. Each key used by
+C<IO::Capture> is named with the class name. I.e., 'IO::Capture::<key_name>'.
+This is to prevent name clashes with keys added by sub-class authors.
+Attributes can be set in the object by passing a hash reference as a single
+argument to new().
+
+ my $capture = IO::Capture->new( { Key => 'value' } );
+
+All elements from this hash will be added to the object, and will be
+available for use by children of IO::Capture.
+
+ my $key = $self->{'Key'};
+
+The internal methods used are:
+
+=over 4
+
+=item C<_initialize()>
+
+C<_initialize> is called as soon as the empty object has been blessed.
+It adds the structure to the object that it will need. The C<IO::Capture>
+module adds the following
+
+ IO::Capture::messages => []
+ IO::Capture::line_pointer => 1
+ IO::Capture::status => 'Ready', # Busy when capturing
+
+=back
+
+=head2 start
+
+The C<start> method is responsible for saving the current state of the
+filehandle and or signal hander, and starting the data capture.
+
+Start cannot be called if there is already a capture in progress. The
+C<stop> must be called first.
+
+These internal methods are called in this order.
+
+=over 4
+
+=item C<_check_pre_conditions>
+
+C<_check_pre_conditions> is used to make sure all the preconditions
+are met before starting a capture. The only precondition checked in
+C<IO::Capture>, is to insure the "Ready" flag is "on". I.e., There is
+not already a capture in progress.
+
+If your module needs to make some checks, and you override this method, make
+sure you call the parent class C<_check_pre_conditions> and check the results.
+
+ sub _check_pre_conditions {
+ my $self = shift;
+
+ return unless $self->SUPER::_check_pre_conditions;
+
+An example of something you might want to check would be,
+to make sure STDERR is not already I<tied> if you are going to be
+using C<tie> on it.
+
+B<Must> return a boolean true for success, or false for failure.
+If a failure is indicated, an C<undef> will be returned to the
+calling function, and an remaining private methods for C<start> will
+B<not> be run.
+
+=item C<_save_current_configuration()>
+
+C<_save_current_configuration> in C<IO::Capture> will save the state of
+C<STDERR>, C<STDOUT>, and $SIG{__WARN__}. They are saved in the hash
+keys 'IO::Capture::stderr_save', 'IO::Capture::stdout_save', and
+'IO::Capture::handler_save'.
+
+ # Save WARN handler
+ $self->{'IO::Capture::handler_save'} = $SIG{__WARN__};
+ # Dup stdout
+ open STDOUT_SAVE, ">&STDOUT";
+ # Save ref to dup
+ $self->{'IO::Capture::stdout_save'} = *STDOUT_SAVE;
+ # Dup stderr
+ open STDERR_SAVE, ">&STDOUT";
+ # Save ref to dup
+ $self->{'IO::Capture::stderr_save'} = *STDERR_SAVE;
+
+
+These saved values can be used in the C<_stop> method to restore the
+original value to any you changed.
+
+ $SIG{__WARN__} = $self->{'IO::Capture::handler_save'};
+ STDOUT = $self->{'IO::Capture::stdout_save'};
+ STDERR = $self->{'IO::Capture::stderr_save'};
+
+B<Must> return a boolean true for success, or false for failure.
+If a failure is indicated, an C<undef> will be returned to the
+calling function.
+
+=item C<_start>
+
+B<Start the capture!> This is only an abstract method in C<IO::Capture>.
+It will print a warning if called. Which should not happen, as the
+author of the sub-class will always be sure to override it with her/his
+own. :-)
+
+This is the first of the three you need to define. You will likely
+use tie here. The included module C<IO::Capture:STDx> (see
+L<IO::Capture::STDx> or other module of your own or from CPAN.
+You will read it from the tied module and put it into the object
+in C<_retrieve_captured_text>. See L<_retrieve_captured_text>
+
+B<Must> return a boolean true for success, or false for failure.
+If a failure is indicated, an C<undef> will be returned to the
+calling function.
+
+=back
+
+=head2 stop
+
+Stop capturing and return any filehandles and interrupt handlers that were
+changed, to their pre-start state. This B<must> be called B<before> calling
+C<read()>. If you are looking for a way to interact with the process on
+the other side of the filehandle, take a look at the L<"Other Modules on CPAN">.
+
+B<Must> return a boolean true for success, or false for failure.
+If a failure is indicated, an C<undef> will be returned to the
+calling function.
+
+=over 4
+
+=item C<_retrieve_captured_text()>
+
+Copy any text captured into the object here. For example, The modules in this
+package tie the filehandle to the (included) C<IO::Capture::STDx> to collect
+the text. The data needs to be read out of the tied object before the filehandle
+is untied, so that is done here. In short, if you need to do any work before
+C<_stop> is called, do it here. The C<_retrieve_capture_text> in this base
+class just returns true without doing anything.
+
+B<Must> return a boolean true for success, or false for failure. If a failure
+is indicated, an C<undef> will be returned to the calling function. The C<_stop>
+internal method will be called first.
+
+=item C<_stop>
+
+Do what needs to be done to put things back. Such as untie filehandles and
+put interrupt handlers back to what they were. The default C<_stop> method
+defined in <IO::Capture> won't do anything, so you should.
+
+B<Must> return a boolean true for success, or false for failure. If a failure
+is indicated, an C<undef> will be returned to the calling function.
+
+=back
+
+=head2 read
+
+The C<read> method is responsible for returning the data captured in the
+object. These internal methods will be run, in this order.
+
+=over 4
+
+=item C<_read()>
+
+The internal method used to return the captured text. If called in I<list
+context>, an array will be returned. (Could be a lot if you captured a lot)
+or called in I<scalar context>, the line pointed to by the I<line_pointer>
+will be returned and the I<line_pointer> incremented.
+
+=back
+
+=head1 Other Modules on CPAN
+
+If this module is not exactly what you were looking for, take a look at these.
+Maybe one of them will fit the bill.
+
+=over 4
+
+=item *
+
+IO::Filter - Generic input/output filters for Perl IO handles
+
+=item *
+
+Expect - Expect for Perl
+
+=item *
+
+Tie::Syslog - Tie a filehandle to Syslog. If you Tie STDERR, then all
+STDERR errors are automatically caught, or you can debug by Carp'ing to
+STDERR, etc. (Good for CGI error logging.)
+
+=item *
+
+FileHandle::Rollback - FileHandle with commit and rollback
+
+=back
+
+=head1 See Also
+
+L<IO::Capture::Overview>
+
+L<IO::Capture::Stdout>
+
+L<IO::Capture::Stderr>
+
+=head1 AUTHORS
+
+Mark Reynolds
+reynolds<at>sgi.com
+
+Jon Morgan
+jmorgan<at>sgi.com
+
+=head1 MAINTAINED
+
+Maintained by Mark Reynolds. reynolds<at>sgi.com
+
+=head1 COPYRIGHT
+
+Copyright (c) 2003 Mark Reynolds and Jon Morgan
+Copyright (c) 2004-2005 Mark Reynolds
+All Rights Reserved. This module is free software. It may be used, redistributed
+and/or modified under the same terms as Perl itself.
+
+=cut
+
+
+sub new {
+ my $class = shift;
+ if (ref $class) {
+ carp "WARNING: " . __PACKAGE__ . "::new cannot be called from existing object. (cloned)";
+ return;
+ }
+ my $object = shift || {};
+ bless $object, $class;
+ $object->_initialize;
+}
+
+sub _check_pre_conditions {
+ my $self = shift;
+
+ if( $self->{'IO::Capture::status'} ne "Ready") {
+ carp "Start issued on an in progress capture ". ref($self);
+ return;
+ }
+
+ return 1;
+}
+
+sub _initialize {
+ my $self = shift;
+ if (!ref $self) {
+ carp "WARNING: _initialize was called, but not called from a valid object";
+ return;
+ }
+
+ $self->{'IO::Capture::messages'} = [];
+ $self->{'IO::Capture::line_pointer'} = 1;
+ $self->{'IO::Capture::status'} = "Ready";
+ return $self;
+}
+
+sub start {
+ my $self = shift;
+
+ if (! $self->_check_pre_conditions) {
+ carp "Error: failed _check_pre_confitions in ". ref($self);
+ return;
+ }
+
+ if (! $self->_save_current_configuration ) {
+ carp "Error saving configuration in " . ref($self);
+ return;
+ }
+
+ $self->{'IO::Capture::status'} = "Busy";
+
+ if (! $self->_start(@_)) {
+ carp "Error starting capture in " . ref($self);
+ return;
+ }
+ return 1;
+}
+
+sub stop {
+ my $self = shift;
+
+ if( $self->{'IO::Capture::status'} ne "Busy") {
+ carp "Stop issued on an unstarted capture ". ref($self);
+ return;
+ }
+
+ if (! $self->_retrieve_captured_text() ) {
+ carp "Error retreaving captured text in " . ref($self);
+ return;
+ }
+
+ if (!$self->_stop() ) {
+ carp "Error return from _stop() " . ref($self) . "\n";
+ return;
+ }
+
+ $self->{'IO::Capture::status'} = "Ready";
+
+ return 1;
+}
+
+sub read {
+ my $self = shift;
+
+ $self->_read;
+}
+
+#
+# Internal start routine. This needs to be overriden with instance
+# method
+#
+sub _start {
+ my $self = shift;
+ return 1;
+}
+
+sub _read {
+ my $self = shift;
+ my $messages = \@{$self->{'IO::Capture::messages'}};
+ my $line_pointer = \$self->{'IO::Capture::line_pointer'};
+
+ if ($self->{'IO::Capture::status'} ne "Ready") {
+ carp "Read cannot be done while capture is in progress". ref($self);
+ return;
+ }
+
+ return if $$line_pointer > @$messages;
+ return wantarray ? @$messages : $messages->[($$line_pointer++)-1];
+}
+
+sub _retrieve_captured_text {
+ return 1;
+
+}
+
+sub _save_current_configuration {
+ my $self = shift;
+ $self->{'IO::Capture::handler_save'} = $SIG{__WARN__};
+ open STDOUT_SAVE, ">&STDOUT";
+ $self->{'IO::Capture::stdout_save'} = *STDOUT_SAVE;
+ open STDERR_SAVE, ">&STDOUT";
+ $self->{'IO::Capture::stderr_save'} = *STDERR_SAVE;
+ return $self;
+}
+
+sub _stop {
+ my $self = shift;
+ return 1;
+}
+
+sub line_pointer {
+ my $self = shift;
+ my $new_number = shift;
+
+ $self->{'IO::Capture::line_pointer'} = $new_number if $new_number;
+ return $self->{'IO::Capture::line_pointer'};
+}
+1;
Added: packages/libio-capture-perl/branches/upstream/current/t/01_1_Published_Methods.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/01_1_Published_Methods.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/01_1_Published_Methods.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,33 @@
+# Published Methods 'Exist' Test
+# vim600: set syn=perl :
+
+use Test::More tests => 6;
+BEGIN { use_ok('IO::Capture') };
+
+my $capture;
+
+# Test 2
+eval { $capture = IO::Capture->new()};
+ok(!$@, "Constructor Test");
+print "Error checking 'new' constructor: $@\n" if $@;
+
+# These will generate some warnings -> preventing from printing
+open STDERR_SAV, ">&STDERR"; open STDERR, ">/dev/null";
+
+eval {$capture->start};
+ok(!$@, "Checking start method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "start": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->stop};
+ok(!$@, "Checking stop method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "stop": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->read};
+ok(!$@, "Checking read method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "read": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->line_pointer};
+ok(!$@, "Checking line_pointer method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "line_pointer": $@\n/ . "*" x 80 . "\n" if $@;
+
+close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
Added: packages/libio-capture-perl/branches/upstream/current/t/01_2_Published_Methods_Stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/01_2_Published_Methods_Stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/01_2_Published_Methods_Stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,37 @@
+# Published Methods 'Exist' Test
+# vim600: set syn=perl :
+
+use Test::More tests => 6;
+BEGIN { use_ok('IO::Capture::Stdout') };
+
+my $capture;
+
+# Test 2
+eval { $capture = IO::Capture::Stdout->new()};
+ok(!$@, "Constructor Test");
+print "Error checking 'new' constructor: $@\n" if $@;
+
+# These will generate some warnings -> preventing from printing
+open STDERR_SAV, ">&STDERR"; open STDERR, ">/dev/null";
+
+eval {$capture->start};
+ok(!$@, "Checking start method" );
+#print "\n" . "*" x 80 . qq/\nError checking published method, "start": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->stop};
+ok(!$@, "Checking stop method" );
+#print "\n" . "*" x 80 . qq/\nError checking published method, "stop": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->read};
+ok(!$@, "Checking read method" );
+#print "\n" . "*" x 80 . qq/\nError checking published method, "read": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->line_pointer};
+ok(!$@, "Checking line_pointer method" );
+#print "\n" . "*" x 80 . qq/\nError checking published method, "line_pointer": $@\n/ . "*" x 80 . "\n" if $@;
+
+for my $line ($capture->read()) {
+ print $line;
+}
+
+close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
Added: packages/libio-capture-perl/branches/upstream/current/t/01_3_Published_Methods_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/01_3_Published_Methods_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/01_3_Published_Methods_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,33 @@
+# Published Methods 'Exist' Test
+# vim600: set syn=perl :
+
+use Test::More tests => 6;
+BEGIN { use_ok('IO::Capture::Stderr') };
+
+my $capture;
+
+# Test 2
+eval { $capture = IO::Capture::Stderr->new()};
+ok(!$@, "Constructor Test");
+print "Error checking 'new' constructor: $@\n" if $@;
+
+# These will generate some warnings -> preventing from printing
+open STDERR_SAV, ">&STDERR"; open STDERR, ">/dev/null";
+
+eval {$capture->start};
+ok(!$@, "Checking start method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "start": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->stop};
+ok(!$@, "Checking stop method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "stop": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->read};
+ok(!$@, "Checking read method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "read": $@\n/ . "*" x 80 . "\n" if $@;
+
+eval {$capture->line_pointer};
+ok(!$@, "Checking line_pointer method" );
+print "\n" . "*" x 80 . qq/\nError checking published method, "line_pointer": $@\n/ . "*" x 80 . "\n" if $@;
+
+close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
Added: packages/libio-capture-perl/branches/upstream/current/t/02_1_basic_base.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/02_1_basic_base.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/02_1_basic_base.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,62 @@
+# vim600: set syn=perl :
+use Test::More tests => 9;
+BEGIN { use_ok('IO::Capture') };
+
+
+#Test 2
+ok (my $capture = IO::Capture->new(), "Constructor Test");
+
+# These will generate some warnings -> preventing from printing
+open STDERR_SAV, ">&STDERR"; open STDERR, ">/dev/null";
+
+# Save current values to check after start/stop
+my ($initial_stdout_dev, $initial_stdout_inum) = (stat(STDOUT))[0,1];
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+my $warn_save = $SIG{__WARN__};
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ $rv2 = $capture->stop() || 0;
+}
+
+# Grab these before putting STDERR back
+my ($ending_stdout_dev, $ending_stdout_inum) = (stat(STDOUT))[0,1];
+my ($ending_stderr_dev, $ending_stderr_inum) = (stat(STDERR))[0,1];
+
+close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
+
+#Test 3
+ok ($rv1, "Start Method");
+
+#Test 4
+ok ($rv2, "Stop Method");
+
+#########################################################
+# Check filehandles - STDOUT ############################
+#########################################################
+
+#Test 5
+ok ($initial_stdout_dev == $ending_stdout_dev, "Invariant Check - STDOUT filesystem dev number ");
+
+#Test 6
+ok ($initial_stdout_inum == $ending_stdout_inum, "Invariant Check - STDOUT inode number");
+
+#########################################################
+# Check filehandles - STDERR ############################
+#########################################################
+
+#Test 7
+ok ($initial_stderr_dev == $ending_stderr_dev, "Invariant Check - STDERR filesystem dev number");
+
+#Test 8
+ok ($initial_stderr_inum == $ending_stderr_inum, "Invariant Check - STDERR inode number");
+
+#########################################################
+# Check $SIG{__WARN__} ##################################
+#########################################################
+
+#Test 9
+my $test_result_9 = $SIG{__WARN__} eq $warn_save;
+ok ($test_result_9, "Invariant Check - __WARN__");
+print "\n" . "*"x60 . "\n__WARN__ did not get restored correctly in $0\n" . "*"x60 . "\n\n" unless $test_result_9;
Added: packages/libio-capture-perl/branches/upstream/current/t/02_2_basic_Stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/02_2_basic_Stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/02_2_basic_Stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,95 @@
+# vim600: set syn=perl :
+use strict;
+use Test::More tests => 13;
+BEGIN { use_ok('IO::Capture::Stdout') };
+
+#Save initial values
+my ($initial_stdout_dev, $initial_stdout_inum) = (stat(STDOUT))[0,1];
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+my $warn_save = $SIG{__WARN__};
+
+#Test 2
+ok (my $capture = IO::Capture::Stdout->new(), "Constructor Test");
+
+#########################################################
+# Start, put some data, Stop ############################
+#########################################################
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ print "Test Line One";
+ print "Test Line Two";
+ print "Test Line Three";
+ print "Test Line Four";
+ $rv2 = $capture->stop() || 0;
+}
+
+#########################################################
+# Check the results #####################################
+#########################################################
+
+#Test 3
+ok ($rv1, "Start Method");
+
+#Test 4
+ok ($rv2, "Stop Method");
+
+#Test 5
+my $line1 = $capture->read();
+my $results_line1 = $line1 eq "Test Line One";
+ok ($results_line1, "Read Method, First Line");
+diag "*"x60 . "\n1st line read was: $line1\n" . "*"x60 . "\n\n" unless $results_line1;
+
+#Test 6
+my $line2 = $capture->read();
+my $results_line2 = $line2 eq "Test Line Two";
+ok ($results_line2, "Read Method, Second Line");
+diag "*"x60 . "\n2nd line read was: $line2\n" . "*"x60 . "\n\n" unless $results_line2;
+
+#Test 7
+my $line3 = $capture->read();
+my $results_line3 = $line3 eq "Test Line Three";
+ok ($results_line3, "Read Method, Third Line");
+diag "*"x60 . "\n3rd line read was: $line3\n" . "*"x60 . "\n\n" unless $results_line3;
+
+
+#Test 8
+$capture->line_pointer(1);
+my $new_line_pointer = $capture->line_pointer;
+ok($new_line_pointer == 1, "Check set line_pointer");
+
+#Test 9
+my $line1_2 = $capture->read();
+my $results_line1_2 = $line1_2 eq "Test Line One";
+ok ($results_line1_2, "Read After line_pointer(), First Line");
+diag "*"x60 .
+ "\nline read after line_pointer() was: $line1_2\n" .
+ "*"x60 .
+ "\n\n"
+ unless $results_line1_2;
+
+#Test 10
+my @lines_array = $capture->read;
+ok(@lines_array == 4, "List Context Check");
+
+
+#########################################################
+# Check for untie #######################################
+#########################################################
+
+#Test 11
+my $tie_check = tied *STDOUT;
+ok(!$tie_check, "Untie Test");
+
+#########################################################
+# Check filehandles - STDOUT ############################
+#########################################################
+
+my ($ending_stdout_dev, $ending_stdout_inum) = (stat(STDOUT))[0,1];
+
+#Test 12
+ok ($initial_stdout_dev == $ending_stdout_dev, "Invariant Check - STDOUT filesystem dev number");
+
+#Test 13
+ok ($initial_stdout_inum == $ending_stdout_inum, "Invariant Check - STDOUT inode number");
Added: packages/libio-capture-perl/branches/upstream/current/t/02_3_basic_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/02_3_basic_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/02_3_basic_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,104 @@
+# vim600: set syn=perl :
+use strict;
+use warnings;
+use Test::More tests => 15;
+
+BEGIN { use_ok('IO::Capture::Stderr') };
+
+#Save initial values
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+
+#Test 2
+ok (my $capture = IO::Capture::Stderr->new(), "Constructor Test");
+
+#########################################################
+# Start, put some data, stop ############################
+#########################################################
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ print STDERR "Test Line One";
+ print STDERR "Test Line Two";
+ print STDERR "Test Line Three";
+ print STDERR "Test Line Four";
+ $rv2 = $capture->stop() || 0;
+}
+
+#########################################################
+# Check the results #####################################
+#########################################################
+
+#Test 3
+ok ($rv1, "Start Method");
+
+#Test 4
+ok ($rv2, "Stop Method");
+
+#Test 5
+my $line1 = $capture->read();
+my $results_line1 = $line1 eq "Test Line One";
+ok ($results_line1, "Read Method, First Line");
+diag "*"x60 . "\n1st line read was: $line1\n" . "*"x60 . "\n\n" unless $results_line1;
+
+#Test 6
+my $line2 = $capture->read();
+my $results_line2 = $line2 eq "Test Line Two";
+ok ($results_line2, "Read Method, Second Line");
+diag "*"x60 . "\n2nd line read was: $line2\n" . "*"x60 . "\n\n" unless $results_line2;
+
+#Test 7
+$capture->line_pointer(1);
+my $new_line = $capture->line_pointer;
+ok($new_line == 1, "Check set line_pointer");
+
+#Test 8
+my $line1_2 = $capture->read();
+my $results_line1_2 = $line1_2 eq "Test Line One";
+ok ($results_line1_2, "Read After line_pointer(), First Line");
+diag "*"x60 .
+ "\nline read after line_pointer() was: $line1_2\n" .
+ "*"x60 .
+ "\n\n"
+ unless $results_line1_2;
+
+
+#Test 9
+my @lines_array = $capture->read;
+ok(@lines_array == 4, "'List' Context Check");
+
+
+#########################################################
+# Check for untie #######################################
+#########################################################
+
+#Test 10
+my $tie_check = tied *STDERR;
+ok(!$tie_check, "Untie Test");
+
+#########################################################
+# Check filehandles - STDERR ############################
+#########################################################
+
+my ($ending_stderr_dev, $ending_stderr_inum) = (stat(STDERR))[0,1];
+#Test 11
+ok ($initial_stderr_dev == $ending_stderr_dev, "Invariant Check - STDERR filesystem dev number");
+
+#Test 12
+ok ($initial_stderr_inum == $ending_stderr_inum, "Invariant Check - STDERR inode number");
+
+#Test 13
+# make sure $SIG{__WARN__} is not set. I.e., It was not left in an odd state
+cmp_ok ( $SIG{__WARN__}, 'eq', '', "warn back to DEFAULT");
+
+#Test 14
+my $warn_handler = sub {print STDERR "Custom warn handler in effect\n"};
+$SIG{__WARN__} = $warn_handler;
+$capture->start();
+warn "Warn test 1";
+$capture->stop();
+my $warn_out = $capture->read();
+cmp_ok( $warn_out, '=~', "Custom warn handler", "Verify custom handler not overridden" );
+
+#Test 15
+cmp_ok( $SIG{__WARN__}, "==", $warn_handler, "Restore warn handler");
Added: packages/libio-capture-perl/branches/upstream/current/t/03_1_Errorcheck_Stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/03_1_Errorcheck_Stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/03_1_Errorcheck_Stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,42 @@
+# vim600: set syn=perl :
+use Test::More tests => 7;
+BEGIN { use_ok('IO::Capture::Stdout') };
+
+# These will generate some warnings -> preventing from printing
+open STDERR_SAV, ">&STDERR"; open STDERR, ">/dev/null";
+
+# Now test creating two captures of the same type and starting both
+my $capture1 = IO::Capture::Stdout->new();
+my $capture2 = IO::Capture::Stdout->new();
+
+my $rv1 = $capture1->start();
+
+#Test 2
+ok(!$capture1->start,"Two starts");
+
+#Test 3
+ok(!$capture2->start(), "Two captures");
+
+$capture2->stop();
+
+#Test 4
+ok(!$capture1->start(), "Two starts");
+
+#Test 5
+ok(!$capture1->read(), "Read before stop");
+
+$capture1->stop();
+
+my $capture3 = IO::Capture::Stdout->new();
+
+#Test 6
+ok(!$capture3->stop(), "Stop before Start");
+
+$capture3->start();
+$capture3->stop();
+
+#Test 7
+ok(!$capture3->stop(), "Two Stops");
+
+# restore STDERR
+close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
Added: packages/libio-capture-perl/branches/upstream/current/t/03_2_Errorcheck_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/03_2_Errorcheck_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/03_2_Errorcheck_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,25 @@
+# vim600: set syn=perl :
+use Test::More tests => 4;
+BEGIN { use_ok('IO::Capture::Stderr') };
+
+# These will generate some warnings -> preventing from printing
+#open STDERR_SAV, ">&STDERR"
+open STDERR, ">/dev/null";
+
+#Test 2
+# Now test creating two captures of the same type and starting both
+my $capture1 = IO::Capture::Stderr->new();
+my $capture2 = IO::Capture::Stderr->new();
+
+my $rv1 = $capture1->start();
+
+ok(!$capture2->start(), "Two captures");
+
+$capture2->stop();
+
+ok(!$capture1->start(), "Two starts");
+
+ok(!$capture1->read(), "Read before stop");
+
+# restore STDERR
+#close STDERR; open STDERR, ">&STDERR_SAV"; close STDERR_SAV;
Added: packages/libio-capture-perl/branches/upstream/current/t/04_1_Side-effects_base.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/04_1_Side-effects_base.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/04_1_Side-effects_base.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,25 @@
+# vim600: set syn=perl :
+use Test::More tests => 5;
+BEGIN { use_ok('IO::Capture') };
+
+# Change SIG{__WARN__} to make sure it gets put back correctly
+$SIG{__WARN__} = sub {print STDERR "Redirected message from warn(): @_\n"};
+my $warn_save = $SIG{__WARN__};
+
+#Test 2
+ok (my $capture = IO::Capture->new(), "Constructor Test");
+
+#Test 3
+ok ($capture->start, "Start Method");
+#Test 4
+ok ($capture->stop, "Stop Method");
+
+
+#########################################################
+# Check WARN ############################################
+#########################################################
+#Test 5
+my $test_result_5 = $SIG{__WARN__} eq $warn_save;
+ok ($test_result_5, "Invariant Check - __WARN__");
+diag "\n" . "*"x60 . "\n__WARN__ did not get restored correctly in $0\n" . "*"x60 . "\n\n" unless $test_result_5;
+
Added: packages/libio-capture-perl/branches/upstream/current/t/04_2_Side-effects_Stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/04_2_Side-effects_Stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/04_2_Side-effects_Stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,25 @@
+# vim600: set syn=perl :
+use Test::More tests => 5;
+BEGIN { use_ok('IO::Capture') };
+
+# Change SIG{__WARN__} to make sure it gets put back correctly
+$SIG{__WARN__} = sub {print STDERR "Redirected message from warn(): @_\n"};
+my $warn_save = $SIG{__WARN__};
+
+#Test 2
+ok (my $capture = IO::Capture->new(), "Constructor Test");
+
+#Test 3
+ok ($capture->start, "Start Method");
+#Test 4
+ok ($capture->stop, "Stop Method");
+
+
+#########################################################
+# Check WARN ############################################
+#########################################################
+#Test 5
+my $test_result_5 = $SIG{__WARN__} eq $warn_save;
+ok ($test_result_5, "Invariant Check - __WARN__");
+diag "\n" . "*"x60 . "\n__WARN__ did not get restored correctly in $0\n" . "*"x60 . "\n\n" unless $test_result_5;
+
Added: packages/libio-capture-perl/branches/upstream/current/t/04_3_Side-effects_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/04_3_Side-effects_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/04_3_Side-effects_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,25 @@
+# vim600: set syn=perl :
+use Test::More tests => 5;
+BEGIN { use_ok('IO::Capture') };
+
+# Change SIG{__WARN__} to make sure it gets put back correctly
+$SIG{__WARN__} = sub {print STDERR "Redirected message from warn(): @_\n"};
+my $warn_save = $SIG{__WARN__};
+
+#Test 2
+ok (my $capture = IO::Capture->new(), "Constructor Test");
+
+#Test 3
+ok ($capture->start, "Start Method");
+#Test 4
+ok ($capture->stop, "Stop Method");
+
+
+#########################################################
+# Check WARN ############################################
+#########################################################
+#Test 5
+my $test_result_5 = $SIG{__WARN__} eq $warn_save;
+ok ($test_result_5, "Invariant Check - __WARN__");
+diag "\n" . "*"x60 . "\n__WARN__ did not get restored correctly in $0\n" . "*"x60 . "\n\n" unless $test_result_5;
+
Added: packages/libio-capture-perl/branches/upstream/current/t/05_2_regression.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/05_2_regression.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/05_2_regression.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,53 @@
+# vim600: set syn=perl :
+use strict;
+use Test::More tests => 3;
+
+use IO::Capture::Stdout;
+use IO::Capture::Stderr;
+
+my $out_capture = IO::Capture::Stdout->new();
+my $err_capture = IO::Capture::Stderr->new();
+
+# Test for bug number 1
+$err_capture->start();
+$out_capture->start();
+$out_capture->stop();
+$err_capture->stop();
+
+ok(!$err_capture->read(), "Test for no error if empty");
+
+# Test for bug number 3
+# A read() in scalar context, followed by one in list context
+#
+
+our $module;
+for $module (qw/Stderr Stdout/) {
+ no strict 'refs';
+ my $module_name = "IO::Capture::$module";
+ my $capture = $module_name->new();
+ use strict 'refs';
+ $capture->start;
+
+ if ($module eq "Stdout") {
+ print "Line 1";
+ }
+ else {
+ print STDERR "Line 1";
+ }
+
+ $capture->stop();
+ my $read_one = $capture->read();
+
+ $capture->start();
+ if ($module eq "Stdout") {
+ print "Line 2";
+ }
+ else {
+ print STDERR "Line 2";
+ }
+ $capture->stop();
+
+ my @read_two = $capture->read();
+
+ ok($read_two[0] eq "Line 2", "Bug 3 - $module");
+}
Added: packages/libio-capture-perl/branches/upstream/current/t/06_2_printf_Stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/06_2_printf_Stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/06_2_printf_Stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,101 @@
+# vim600: set syn=perl :
+use strict;
+use Test::More tests => 14;
+BEGIN { use_ok('IO::Capture::Stdout') };
+
+#Save initial values
+my ($initial_stdout_dev, $initial_stdout_inum) = (stat(STDOUT))[0,1];
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+my $warn_save = $SIG{__WARN__};
+
+#Test 2
+ok (my $capture = IO::Capture::Stdout->new(), "Constructor Test");
+
+#########################################################
+# Start, put some data, Stop ############################
+#########################################################
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ printf("Test Line %08d", 1);
+ printf("Test Line %.3f", 2);
+ printf("Test Line %8d", 3);
+ printf("Test Line %s", '4');
+
+ $rv2 = $capture->stop() || 0;
+}
+
+#########################################################
+# Check the results #####################################
+#########################################################
+
+#Test 3
+ok ($rv1, "Start Method");
+
+#Test 4
+ok ($rv2, "Stop Method");
+
+#Test 5
+my $line1 = $capture->read();
+my $results_line1 = $line1 eq "Test Line 00000001";
+ok ($results_line1, "Read Method via printf, First Line");
+diag "*"x60 . "\n1st line read was: $line1\n" . "*"x60 . "\n\n" unless $results_line1;
+
+#Test 6
+my $line2 = $capture->read();
+my $results_line2 = $line2 eq "Test Line 2.000";
+ok ($results_line2, "Read Method via printf, Second Line");
+diag "*"x60 . "\n2nd line read was: $line2\n" . "*"x60 . "\n\n" unless $results_line2;
+
+#Test 7
+my $line3 = $capture->read();
+my $results_line3 = $line3 eq "Test Line 3";
+ok ($results_line3, "Read Method via printf, Third Line");
+diag "*"x60 . "\n3rd line read was: $line3\n" . "*"x60 . "\n\n" unless $results_line3;
+
+
+#Test 8
+$capture->line_pointer(1);
+my $new_line_pointer = $capture->line_pointer;
+ok($new_line_pointer == 1, "Check set line_pointer");
+
+#Test 9
+my $line1_2 = $capture->read();
+my $results_line1_2 = $line1_2 eq "Test Line 00000001";
+ok ($results_line1_2,
+ "Read method via printf after line_pointer(), First Line");
+diag "*"x60 .
+ "\nline read after line_pointer() was: $line1_2\n" .
+ "*"x60 .
+ "\n\n"
+ unless $results_line1_2;
+
+#Test 10
+my @lines_array = $capture->read;
+ok(@lines_array == 4, "List Context Check");
+
+is($lines_array[3], 'Test Line 4',
+ "List Context: check for individual element");
+
+
+#########################################################
+# Check for untie #######################################
+#########################################################
+
+#Test 11
+my $tie_check = tied *STDOUT;
+ok(!$tie_check, "Untie Test");
+
+#########################################################
+# Check filehandles - STDOUT ############################
+#########################################################
+
+my ($ending_stdout_dev, $ending_stdout_inum) = (stat(STDOUT))[0,1];
+
+#Test 12
+ok ($initial_stdout_dev == $ending_stdout_dev, "Invariant Check - STDOUT filesystem dev number");
+
+#Test 13
+ok ($initial_stdout_inum == $ending_stdout_inum, "Invariant Check - STDOUT inode number");
+
Added: packages/libio-capture-perl/branches/upstream/current/t/06_3_printf_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/06_3_printf_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/06_3_printf_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,90 @@
+# vim600: set syn=perl :
+use Test::More tests => 13;
+BEGIN { use_ok('IO::Capture::Stderr') };
+
+#Save initial values
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+
+#Test 2
+ok (my $capture = IO::Capture::Stderr->new(), "Constructor Test");
+
+#########################################################
+# Start, put some data, stop ############################
+#########################################################
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ printf STDERR ("Test Line %08d", 1);
+ printf STDERR ("Test Line %.3f", 2);
+ printf STDERR ("Test Line %8d", 3);
+ printf STDERR ("Test Line %s", '4');
+ $rv2 = $capture->stop() || 0;
+}
+
+#########################################################
+# Check the results #####################################
+#########################################################
+
+#Test 3
+ok ($rv1, "Start Method");
+
+#Test 4
+ok ($rv2, "Stop Method");
+
+#Test 5
+my $line1 = $capture->read();
+my $results_line1 = $line1 eq "Test Line 00000001";
+ok ($results_line1, "Read Method via printf, First Line");
+diag "*"x60 . "\n1st line read was: $line1\n" . "*"x60 . "\n\n" unless $results_line1;
+
+#Test 6
+my $line2 = $capture->read();
+my $results_line2 = $line2 eq "Test Line 2.000";
+ok ($results_line2, "Read Method via printf, Second Line");
+diag "*"x60 . "\n2nd line read was: $line2\n" . "*"x60 . "\n\n" unless $results_line2;
+
+#Test 7
+$capture->line_pointer(1);
+my $new_line = $capture->line_pointer;
+ok($new_line == 1, "Check set line_pointer");
+
+#Test 8
+my $line1_2 = $capture->read();
+my $results_line1_2 = $line1_2 eq "Test Line 00000001";
+ok ($results_line1_2,
+ "Read method via printf after line_pointer(), First Line");
+diag "*"x60 .
+ "\nline read after line_pointer() was: $line1_2\n" .
+ "*"x60 .
+ "\n\n"
+ unless $results_line1_2;
+
+
+#Test 9
+my @lines_array = $capture->read;
+ok(@lines_array == 4, "List Context Check");
+
+is($lines_array[3], 'Test Line 4',
+ "List Context: check for individual element");
+
+
+#########################################################
+# Check for untie #######################################
+#########################################################
+
+#Test 10
+my $tie_check = tied *STDERR;
+ok(!$tie_check, "Untie Test");
+
+#########################################################
+# Check filehandles - STDERR ############################
+#########################################################
+
+my ($ending_stderr_dev, $ending_stderr_inum) = (stat(STDERR))[0,1];
+#Test 11
+ok ($initial_stderr_dev == $ending_stderr_dev, "Invariant Check - STDERR filesystem dev number");
+
+#Test 12
+ok ($initial_stderr_inum == $ending_stderr_inum, "Invariant Check - STDERR inode number");
+
Added: packages/libio-capture-perl/branches/upstream/current/t/06_printf_stdout.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/06_printf_stdout.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/06_printf_stdout.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,13 @@
+use strict;
+use warnings;
+use Test::More tests => 1;
+
+use IO::Capture::Stdout;
+
+my $capture = IO::Capture::Stdout->new();
+$capture->start();
+
+printf "Hello World";
+
+$capture->stop();
+is($capture->read, "Hello World");
Added: packages/libio-capture-perl/branches/upstream/current/t/07_3_warn_Stderr.t
===================================================================
--- packages/libio-capture-perl/branches/upstream/current/t/07_3_warn_Stderr.t 2005-12-28 14:00:29 UTC (rev 1787)
+++ packages/libio-capture-perl/branches/upstream/current/t/07_3_warn_Stderr.t 2005-12-28 14:21:11 UTC (rev 1788)
@@ -0,0 +1,70 @@
+# vim600: set syn=perl :
+use strict;
+use warnings;
+use Test::More tests => 9;
+BEGIN { use_ok('IO::Capture::Stderr') };
+
+#Save initial values
+my ($initial_stderr_dev, $initial_stderr_inum) = (stat(STDERR))[0,1];
+
+# Tests the additional functionality to steal the WARN Handler.
+# (and then put back)
+
+#Test 2
+ok (my $capture = IO::Capture::Stderr->new( {FORCE_CAPTURE_WARN => 1} ), "Constructor Test");
+
+# Set a new handler
+my $new_handler = sub {print "Test message to STDERR - Please ignore. It is normal. :-)\n"};
+$SIG{__WARN__} = $new_handler;
+
+#########################################################
+# Start, put some data, stop ############################
+#########################################################
+
+my $rv1 = $capture->start() || 0;
+my $rv2;
+if ($rv1) {
+ warn "Test Line One";
+ warn "Test Line Two";
+ warn "Test Line Three";
+ warn "Test Line Four";
+ $rv2 = $capture->stop() || 0;
+}
+
+#########################################################
+# Check the results #####################################
+#########################################################
+
+#Test 3
+ok ($rv1, "Start Method returned true");
+
+#Test 4
+ok ($rv2, "Stop Method returned true");
+
+#Test 5
+my $line1 = $capture->read();
+cmp_ok ($line1, "==", undef, "Don't overwrite program's handler");
+
+#########################################################
+# Check for untie #######################################
+#########################################################
+
+#Test 6
+my $tie_check = tied *STDERR;
+ok(!$tie_check, "Untie Test");
+
+#########################################################
+# Check filehandles - STDERR ############################
+#########################################################
+
+my ($ending_stderr_dev, $ending_stderr_inum) = (stat(STDERR))[0,1];
+#Test 7
+ok ($initial_stderr_dev == $ending_stderr_dev, "Invariant Check - STDERR filesystem dev number");
+
+#Test 8
+ok ($initial_stderr_inum == $ending_stderr_inum, "Invariant Check - STDERR inode number");
+
+#Test 9
+# make sure $SIG{__WARN__} is set back to original
+cmp_ok ( $SIG{__WARN__}, '==', $new_handler, "warn back to beginning hander");
+
More information about the Pkg-perl-cvs-commits
mailing list