Controlling STDOUT

hesco has asked for the wisdom of the Perl Monks concerning the following question:

UPDATE

JD Porter's advise filled the bill. As soon as I broke it down and made in plain for posting here, it was working and exhibiting the behavior I was looking for in my module. Thanks for reminding me of the basics. Next to propogate what I learned back into the real code.

Just to be clear. The first readmore tags below include the working code. The second set of hidden code was the broken code from my original post.

-- Hugh

This follows up a question I put to SoPW a couple of days ago. Redirecting STDOUT elicited a couple of ideas. But apparently I'm still not holding my mouth quite right.

Hidden by the readmore tags is a test script I'm developing to exercise a module I'm building, also available below. The module's purpose is to monitor a set of websites to ensure they are up, and that key functions are available, and to alert a server administrator should there be cause for alarm.

I've tried a couple of different strategies for controling STDOUT, redirecting it to a log file for later analysis, etc. But nothing seems to gel.

I had thought that braces were sort of like Las Vegas, in that what happened there stays there.

My test script calls the constructor provided by my package, then uses it to invoke the ->test_sites() method in the module. After argument parsing and sanity checking, this routine defined log files for the STD file handles, constructs a Test::Builder object, then uses Test::Builder's methods to redirect its STDOUT and its diagnostoc output.

What I'm looking to do is to have my test script run a module which runs Test::More style tests on a dataset, with the test output (STD and diagnostic) redirected to a place, where my module can later analyze it to determine what it should do next.

I'm watching the feedback I see in my console, and the log files I'm creating and test results which are outside of the braces for which STDOUT ought to be redirected get into the log file, but results from tests run inside those braces make it neither to my console, nor to the log.

Any ideas what I may be missing here?

-- Hugh

My test case test script

#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 12;

use lib qw{/home/hesco/sb/gpca/ews/Test-MonitorSites};
use sb::redirection_test;

my $obj = sb::redirection_test->new();
isa_ok($obj,'sb::redirection_test');
can_ok($obj,'test_sites');
$obj->test_sites();

is(6,6,'Six is six.');
is(6,8,'Six is eight.');

1;
[download]

My test case simplified module.

package sb::redirection_test;
use strict;
use warnings;
use Test::Builder;
use Test::More;

#
# Redirect and capture output
# and diagnostocs from tests
#

1;

sub new {
  my $class = shift;
  my $self = {};
  bless $self, $class;
  return $self;
}

sub test_sites {
  my $self = shift;
  my $sites = shift;
  my $log_file = '/tmp/test_sites_output';
  my $log_file_ok = '/tmp/test_sites_output_ok';
  my $log_file_diag = '/tmp/test_sites_output_diag';
  my $log_file_todo = '/tmp/test_sites_output_todo';

  my $Test = Test::Builder->new;
  my @handle_names = qw/ output failure_output todo_output /;
  my %old;
  $old{$_} = $Test->$_ for @handle_names;
  $Test->$_(\*STDOUT) for @handle_names;

   {
    $Test->output($log_file_ok);
    $Test->failure_output($log_file_diag);
    $Test->todo_output($log_file_todo);

      is(1,1,'One is one.');
      is(1,2,'One is two.');
      like('These tests are run with output redirected',qr/tests/,'tes
+ts is like tests w
/ redirected output.');
      like('These tests are run with output redirected',qr/tarts/,'tes
+ts is like tarts w
/ redirected output.');
      diag("We're redirecting test diagnostics here.");
      print "We're redirecting STDOUT here.\n";
      print STDERR "We're redirecting STDERR here.\n";
      $self->_test_test();

   }
  $Test->todo_output(*STDOUT);
  $Test->failure_output(*STDERR);
  $Test->output(*STDOUT);

  return;
}

sub _test_test {
  is(3,3,'Three is three.');
  is(3,5,'Three is five.');
  like('These tests are run with output redirected',qr/tests/,'tests i
+s like tests in su
broutine w/ redirected output.');
  like('These tests are run with output redirected',qr/tarts/,'tests i
+s like tarts in su
broutine w/ redirected output.');
  diag("We're redirecting test diagnostics here while inside a subrout
+ine call.");
  print "We're redirecting STDOUT here while inside a subroutine call.
+\n";
  print STDERR "We're redirecting STDERR here while inside a subroutin
+e call.\n";
  return;
}
[download]

And should you care to wade through a very rough approximation of where I'm headed with all of this,

package Test::MonitorSites;

use warnings;
use strict;
use Carp;
use Config::Simple;
use WWW::Mechanize;
use Test::WWW::Mechanize;
use Test::HTML::Tidy;
use HTTP::Request::Common;
use Test::More;
use Data::Dumper;
# use IO::NestedCapture qw/ :subroutines /;
use Test::Builder;

use vars qw($VERSION);
$VERSION = '0.01';

1; # Magic true value required at end of module

sub new {
  my $class = shift;
  my $args = shift;
  my $self = {};
  my ($cfg,%sites,@sites,$site);

  if (defined($args->{'config_file'})){
    my $config_file = $args->{'config_file'};
    if(-s $config_file){
      $cfg = new Config::Simple($config_file);
      # %sites = $cfg->vars();
      if(!defined($cfg->{'_DATA'})){
        $self->{'config_file'} = undef;
        $self->{'error'} = 'No configuration data is available.';
      } else {
        foreach my $key (keys %{$cfg->{'_DATA'}}){
          if($key =~ m/^site_/){
            $site = $key;
            $site =~ s/^site_//;
            push @sites, $site;
          }
        }
        # print STDERR @sites, "\n";
        $self->{'sites'} = \@sites;
        my $cwd;
        {
          no strict 'refs';
          $cwd = `pwd`;
        }
        # print STDERR "The current working directory is: $cwd.\n";
        if(defined($cfg->param('global.result_log'))){
          $self->{'result_log'} = $cwd . '/' . $cfg->param('global.res
+ult_log');
        } else {
          $self->{'result_log'} = "$cwd/Test_MonitorSites_result.log";
        }
      }
    } else {
      $self->{'config_file'} = undef;
      $self->{'error'} = 'The config_file was not found, or was empty.
+';
    }
  } else {
    $self->{'config_file'} = undef;
    $self->{'error'} = 'The config_file was not set in the constructor
+.';
  }
  $self->{'config'} = $cfg;
  my $agent = WWW::Mechanize->new();
  $self->{'agent'} = $agent;

  bless $self, $class;
  return $self;
}

sub test_sites {
  my $self = shift;
  my $sites = shift;
  my(%sites);
  if(defined($sites)){
    %sites = %{$sites};
  } elsif(defined($self->{'config'}->{'_DATA'})) {
    %sites = %{$self->{'config'}->{'_DATA'}};
    foreach my $key (keys %sites){
      if($key !~ m/^site_/){
        delete $sites{$key};
      }
    }
  } else {
    $self->{'error'} = 'No sites have been identified for testing.  Pl
+ease add sites to:
 ' . $self->{'config_file'};
  }

  my ($key, $url, $expected_content);
  my(@url,@expected,@sites);
  my $agent = $self->{'agent'};
  # print STDERR Dumper(\%sites);
  my $log_file = '/tmp/test_sites_output';
  my $log_file_ok = '/tmp/test_sites_output_ok';
  my $log_file_diag = '/tmp/test_sites_output_diag';
  my $log_file_todo = '/tmp/test_sites_output_todo';

  my $Test = Test::Builder->new;
  my @handle_names = qw/ output failure_output todo_output /;
  my %old;
  $old{$_} = $Test->$_ for @handle_names;
  $Test->$_(\*STDOUT) for @handle_names;

  {
    $Test->output($log_file_ok);
    # $Test->failure_output($log_file_diag);
    # $Test->todo_output($log_file_todo);

    foreach my $site (keys %{$sites}){
      diag("Next . . . $site");
      push @sites, $site;
      diag("The site is $site");
      # @url = @{$sites->{'url'}};
      @url = @{$self->{'config'}->{'_DATA'}->{"site_$site"}->{'url'}};
      @expected = @{$self->{'config'}->{'_DATA'}->{"site_$site"}->{'ex
+pected_content'}};
      # $agent->get($url[0]);
      # like($url[0],qr/$site/,"Got correct url for $site.");
      # like($agent->content(),qr/$expected[0]/,"  .  .  .  and found 
+expected content")
;
      # $url = $sites->{"site_$site"}->{'url'};
      # $expected_content = $sites{"site_$site"}{'expected_content'};
      diag("The url is $url[0]");
      print "The url is $url[0]";
      diag("We expect the find: $expected[0]");
      print "We expect the find: $expected[0]";
      is(1,1,'One is one.');
      like('catastrophe',qr/cat/,'Catastrophe is like cat.');
      $self->_test_site($agent,$url[0],$expected[0]);
      $self->_test_links($agent,$url);
      $self->_test_valid_html($url);

    }
    # ...[play with $var]...;
    $Test->todo_output(*STDOUT);
    # $Test->failure_output(*STDERR);
    # $Test->output(*STDOUT);
  }

  my %result = (
         'sites' => $self->{'sites'},
         'planned' => '',
         'run' => '',
         'passed' => '',
         'failed' => '',
         'critical_failues' => '',
       );

  return \%result;
}

sub _test_links {
  my ($self,$agent,$url) = @_;
  # my $mech = Test::WWW::Mechanize->new();
  $agent->get_ok($url, " . . . linked to $url");
  $agent->page_links_ok( " . . . successfully checked all links" );
  return;
}

sub _test_valid_html {
  my ($self,$agent,$url) = @_;
  $agent->get_ok($url, " . . . linked to $url");
  html_tidy_ok( $agent->content(), " . . . html content is valid" );
  return;
}

sub _test_site {
  my($self,$agent,$url,$expected_content) = @_;
  # my $agent = WWW::Mechanize->new();
  $agent->get("$url");
  is ($agent->success,1,"Successfully linked to $url.");
  like($agent->content,qr/$expected_content/,' . . . and found expecte
+d content');
  return $agent->success();
}

__END__

=head1 NAME

Test::MonitorSites - Monitor availability and function of a hash of we
+bsites
[download]

This is a script I'm working on, to test it, called: t/12_exercise_test_sites_method.t

#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More tests => 6;
use Data::Dumper;
use WWW::Mechanize;

use lib qw{lib};
use Test::MonitorSites;

my $package = 'Test::MonitorSites';
foreach my $method ('new', 'test_sites', 'email', 'sms') {
#  can_ok($package,$method);
}

my $cwd = `pwd`;
chomp($cwd);
my $config_file = "$cwd/t/testsuite.ini";
# diag('We\'re using as our config file: ');
# diag("     " . $config_file);
my $tester = Test::MonitorSites->new( { 'config_file' => $config_file 
+} );
isa_ok($tester,'Test::MonitorSites');
isa_ok($tester->{'config'},'Config::Simple');
isa_ok($tester->{'agent'},'WWW::Mechanize');

$package = 'Config::Simple';
foreach my $method ('new', 'param', 'vars') {
#  can_ok($package,$method);
}

my $results = $tester->test_sites();
is(defined($results->{'sites'}),1,'The result returned a sites value')
+;
is(ref $results->{'sites'},'ARRAY','The sites value is an array');
my $sites_count = @{$results->{'sites'}};
is($sites_count,3,'It includes the right number of sites');

my (@url,@expected);
foreach my $site (@{$tester->{'sites'}}){
  @url = @{$tester->{'config'}->{'_DATA'}->{"site_$site"}->{'url'}};
  @expected = @{$tester->{'config'}->{'_DATA'}->{"site_$site"}->{'expe
+cted_content'}};
  diag("The url is: $url[0].");
  diag("We expect to find: $expected[0].");
  # $agent->get($url[0]);
  # like($url[0],qr/$site/,"Got correct url for $site.");
  # like($agent->content(),qr/$expected[0]/,"  .  .  .  and found expe
+cted content");
}

1;
[download]

if( $lal && $lol ) { $life++; }

Comment on Controlling STDOUT Select or Download Code

Replies are listed 'Best First'.
Re: Controlling STDOUT by jdporter (Paladin) on Feb 13, 2007 at 22:59 UTC
That's an awful lot of code to wade through, just to figure out what your problem is, when it could probably be illustrated in about 4 lines of perl code. Post the smallest snippet of code that exhibits (or triggers) the questionable behavior. Thanks. A word spoken in Mind will reach its own level, in the objective world, by its own weight	[reply]