[cgiapp] bizarre TAP::Parser behavior

Mon May 4 00:21:48 EDT 2009

Hello all!

Sorry for double posting this, but I am not sure what is acting up,
CGI::Application or TAP::Parser.  I am afraid that it may be a combination
of the two.

I have written a small module that will turn TAP into color coded html.  It
seems to work fine when I run it from a special standalone service, but if I
run it directly inside of a CGI::Application controller the output never
actually gets parsed.  It's extremely strange: if I run the TAP somehow ends
up being the output of running some apache related binary (it outputs a
bunch of help on what switches to use etc.) And then if I run it with
CGI::Application::Server the output never goes to TAP::Parser at all and
instead gets output to the console and the server doesn't get any of it.
Does anyone know what's going on?  Here's my code:

Module:
--
package WebTest::Tester;
use Moose;
use feature ':5.10';

use File::Find::Rule;
use TAP::Parser;
use File::Spec;
use File::stat;
use Carp;

has directory => (
   is       => 'rw',
   isa      => 'Str',
   required => 1,
   reader   => 'get_directory',
   writer   => 'set_directory',
);

sub tests {
   my $self  = shift;
   my @files = File::Find::Rule->file()->name('*.t')
      ->in( File::Spec->catdir( $self->get_directory, 't' ) );

   my @total_results;

   foreach my $file (@files) {
      push @total_results, "<span class='file'>$file</span>";
      my $parser = TAP::Parser->new( { source => $file } );
      $aggregate->add( $file => $parser );
      RESULT:
      while ( my $result = $parser->next ) {
         given ( $result->type ) {
            when ( 'plan' ) {
               push @total_results, q{<span
class='plan'>}.$result->plan.q{</span>};
            }
            when ( 'test' ) {
               my @ok = ( $result->is_ok )
                  ? ( q{<span class='passed-test'>ok},q{</span>} )
                  : ( q{<span class='failed-test'>not ok},q{</span>} );
               my $todo = ( $result->has_todo )
                  ? ' # TODO '.$result->explanation
                  : '';
               push @total_results, "$ok[0] ".$result->number.q{
}.$result->description."$todo</span>";
            }
            when ( 'comment' ) {
               push @total_results, q{<span class='comment'>#
}.$result->comment.'</span>';
            }
            default {
               push @total_results, q{<span class ='unknown'>#
}.$result->as_string.'</span>';
            }
         }
      }
   }
   return join "\n", @total_results;
}

no Moose;
__PACKAGE__->meta->make_immutable;

Controller:
--
package WebTest::Controller;
use strict;
use warnings;
use base 'CGI::Application';
use feature ':5.10';
use CGI::Application::Plugin::AutoRunmode;
use WebTest::Tester;

sub main : StartRunmode {
   my $self = shift;
   my $output = <<'HTML';
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "
http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
 <link href="/css/css.css" rel="stylesheet" type="text/css" />
 <title>Tested!!!!</title>
</head>
<body><pre>
HTML

   my $tester = WebTest::Tester->new( { directory =>
'/home/frew/personal/web_test' } );
   $output .= $tester->tests;
   $output .= <<'HTML';
</pre>
</body>
</html>
HTML

   return $output;
}

1;

and lastly, the standalone CGI::Application::Server:
--
#!perl
use strict;
use warnings;
use CGI::Application::Server;
use FindBin;
use lib "$FindBin::Bin/../lib";
use WebCritic::Controller;
use Readonly;
Readonly my $port => shift || 5053;
Readonly my $dir => shift || q{.};

my $server = CGI::Application::Server->new($port);
my $app = WebCritic::Controller->new(PARAMS => {
   dir => $dir
});

$server->entry_points({
      '/critic'     => $app
   });
$server->document_root("$FindBin::Bin/../static");
$server->run();

I'd really appreciate any help at all.  This is quite strange.

-- 
fREW Schmidt
http://blog.afoolishmanifesto.com