IO-Capture-0.05/000755 100352 000144 00000000000 10234575751 014022 5ustar00reynoldscsc000000 000000 IO-Capture-0.05/BUGS000644 100352 000144 00000001516 10234575736 014513 0ustar00reynoldscsc000000 000000 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 IO-Capture-0.05/Changes000644 100352 000144 00000002211 10234474535 015307 0ustar00reynoldscsc000000 000000 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. IO-Capture-0.05/MANIFEST000644 100352 000144 00000001211 10214316371 015133 0ustar00reynoldscsc000000 000000 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) IO-Capture-0.05/META.yml000644 100352 000144 00000000572 10234475040 015265 0ustar00reynoldscsc000000 000000 # 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 IO-Capture-0.05/Makefile.PL000644 100352 000144 00000000464 10213621055 015762 0ustar00reynoldscsc000000 000000 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}, ); IO-Capture-0.05/README000644 100352 000144 00000002562 10234474535 014705 0ustar00reynoldscsc000000 000000 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 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. IO-Capture-0.05/lib/000755 100352 000144 00000000000 10234575751 014570 5ustar00reynoldscsc000000 000000 IO-Capture-0.05/lib/IO/000755 100352 000144 00000000000 10234575751 015077 5ustar00reynoldscsc000000 000000 IO-Capture-0.05/lib/IO/Capture/000755 100352 000144 00000000000 10234575751 016502 5ustar00reynoldscsc000000 000000 IO-Capture-0.05/lib/IO/Capture/Overview.pod000644 100352 000144 00000015326 10234474664 021024 0ustar00reynoldscsc000000 000000 =head1 NAME Overview of C 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. =head2 IO::Capture::Stdout Module to capture C from program. See L. =head2 IO::Capture::Stderr Module to capture C from program. See L. =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 and C) are currently identical, and C 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 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. Pay special attention to the internal methods that are only defined as I methods in C. For examples, look at the sub-classes included with this distribution. (C, C. 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. # # 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 = ; } sub _stop { untie *STDERR; return 1; } 1; Lets say you don't want to capture B 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 () { push @$messages, $_ if /error/i; } } Yes. You could do this easier by just using C 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 method and have the arguments passed in as an anonymous array. See the C 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 reynoldssgi.com Note: C 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 IO-Capture-0.05/lib/IO/Capture/Stderr.pm000644 100352 000144 00000021447 10234572350 020303 0ustar00reynoldscsc000000 000000 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 = ; 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 - Capture all output sent to C =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, is derived from the abstract class C. See L. The purpose of the module (as the name suggests) is to capture any output sent to C. After the capture is stopped, the STDOUT filehandle will be reset to the previous location. E.g., If previously redirected to a file, when Cstop> 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 Object. =item * Can B be called on an object that is already capturing. =item * Can B be called while STDERR tied to an object. =item * C 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 =over 4 =item * Lines are read from the buffer at the position of the C, and the pointer is incremented by one. $next_line = $capture->read; =back =item * In I =over 4 =item * The array is returned. The C is not affected. @buffer = $capture->read; =back =item * Data lines are returned exactly as they were captured. You may want to use C 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. 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 function calls. This is because output from I is normally directed to STDERR. If you wish to force IO::Capture::Stderr to grab the text from I, set FORCE_CAPTURE_WARN to a 1. Then C will save the handle that C<$SIG{__WARN__}> was set to, redirect it to itself on C, and then set C<$SIG{__WARN__}> back after C 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. =over 4 =item 1 Give your package a name package MyPackage; =item 2 Use this C 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 L L =head1 AUTHORS Mark Reynolds reynolds@sgi.com Jon Morgan jmorgan@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 IO-Capture-0.05/lib/IO/Capture/Stdout.pm000644 100352 000144 00000012325 10234474640 020320 0ustar00reynoldscsc000000 000000 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 = ; #$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, is derived from the abstract class C. See L. The purpose of the module (as the name suggests) is to capture any output sent to C. After the capture is stopped, the STDOUT filehandle will be reset to the previous location. E.g., If previously redirected to a file, when Cstop> 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 Object. =item * Can B be called on an object that is already capturing. =item * Can B be called while STDOUT tied to an object. =item * C 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 =over 4 =item * Lines are read from the buffer at the position of the C, and the pointer is incremented by one. $next_line = $capture->read; =back =item * In I =over 4 =item * The array is returned. The C is not affected. @buffer = $capture->read; =back =item * Data lines are returned exactly as they were captured. You may want to use C 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. 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. =over 4 =item 1 Give your package a name package MyPackage; =item 2 Use this C 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 L L =head1 AUTHORS Mark Reynolds reynolds@sgi.com Jon Morgan jmorgan@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 IO-Capture-0.05/lib/IO/Capture/Tie_STDx.pm000644 100352 000144 00000001436 10213647071 020457 0ustar00reynoldscsc000000 000000 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 '',@_; } 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 = ; untie *STDOUT; =head1 DESCRIPTION The module C is a small utility module for use by C derived modules. See L It is used to tie STDOUT or STDERR. =cut 1; IO-Capture-0.05/lib/IO/Capture.pm000644 100352 000144 00000026337 10234572606 017047 0ustar00reynoldscsc000000 000000 package IO::Capture; $VERSION = 0.05; use strict; use Carp; =head1 NAME C - Abstract Base Class to build modules to capture output. =head1 DESCRIPTION The C 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 on CPAN. See L for a discussion of these modules and examples of how to build a module to sub-class from C yourself. If after reading the overview, you would like to build a class from C, look here for details on the internals. =head1 METHODS These are the methods defined in the C Module. This page will be discussing the module from the point of view of someone who wants to build a sub-class of C. Each method defined in the C 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 override if you want your module to B 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 method creates a new C object, and returns it to its caller. The object is implemented with a hash. Each key used by C is named with the class name. I.e., 'IO::Capture::'. 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 module adds the following IO::Capture::messages => [] IO::Capture::line_pointer => 1 IO::Capture::status => 'Ready', # Busy when capturing =back =head2 start The C 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 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, 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 if you are going to be using C on it. B return a boolean true for success, or false for failure. If a failure is indicated, an C will be returned to the calling function, and an remaining private methods for C will B be run. =item C<_save_current_configuration()> C<_save_current_configuration> in C will save the state of C, C, 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 return a boolean true for success, or false for failure. If a failure is indicated, an C will be returned to the calling function. =item C<_start> B This is only an abstract method in C. 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 (see L 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 return a boolean true for success, or false for failure. If a failure is indicated, an C 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 be called B calling C. 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 return a boolean true for success, or false for failure. If a failure is indicated, an C 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 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 return a boolean true for success, or false for failure. If a failure is indicated, an C 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 won't do anything, so you should. B return a boolean true for success, or false for failure. If a failure is indicated, an C will be returned to the calling function. =back =head2 read The C 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, an array will be returned. (Could be a lot if you captured a lot) or called in I, the line pointed to by the I will be returned and the I 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 L L =head1 AUTHORS Mark Reynolds reynoldssgi.com Jon Morgan jmorgansgi.com =head1 MAINTAINED Maintained by Mark Reynolds. reynoldssgi.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; IO-Capture-0.05/t/000755 100352 000144 00000000000 10234575751 014265 5ustar00reynoldscsc000000 000000 IO-Capture-0.05/t/01_1_Published_Methods.t000644 100352 000144 00000002127 07650025474 020576 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/01_2_Published_Methods_Stdout.t000644 100352 000144 00000002241 07774475711 022150 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/01_3_Published_Methods_Stderr.t000644 100352 000144 00000002147 07650026242 022117 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/02_1_basic_base.t000644 100352 000144 00000004021 07650025474 017243 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/02_2_basic_Stdout.t000644 100352 000144 00000005503 07774476012 017627 0ustar00reynoldscsc000000 000000 # 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"); IO-Capture-0.05/t/02_3_basic_Stderr.t000644 100352 000144 00000006040 10214316425 017566 0ustar00reynoldscsc000000 000000 # 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"); IO-Capture-0.05/t/03_1_Errorcheck_Stdout.t000644 100352 000144 00000001603 07774476105 020635 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/03_2_Errorcheck_Stderr.t000644 100352 000144 00000001174 07774476157 020631 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/04_1_Side-effects_base.t000644 100352 000144 00000001461 07650025474 020472 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/04_2_Side-effects_Stdout.t000644 100352 000144 00000001461 07650025474 021043 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/04_3_Side-effects_Stderr.t000644 100352 000144 00000001461 07650025474 021025 0ustar00reynoldscsc000000 000000 # 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; IO-Capture-0.05/t/05_2_regression.t000644 100352 000144 00000001762 10213602663 017353 0ustar00reynoldscsc000000 000000 # 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"); } IO-Capture-0.05/t/06_2_printf_Stdout.t000644 100352 000144 00000005770 10213621520 020034 0ustar00reynoldscsc000000 000000 # 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"); IO-Capture-0.05/t/06_3_printf_Stderr.t000644 100352 000144 00000005243 10213621520 020011 0ustar00reynoldscsc000000 000000 # 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"); IO-Capture-0.05/t/06_printf_stdout.t000644 100352 000144 00000000334 10213603120 017636 0ustar00reynoldscsc000000 000000 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"); IO-Capture-0.05/t/07_3_warn_Stderr.t000644 100352 000144 00000004135 10214316475 017471 0ustar00reynoldscsc000000 000000 # 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");