# Copyright (c) 2002-2008 bivio Software, Inc. All Rights Reserved. # # Visit http://www.bivio.biz for more info. # # This library is free software; you can redistribute it and/or modify # it under the terms of the GNU Lesser General Public License as # published by the Free Software Foundation; either version 2.1 of the # License, or (at your option) any later version. # # This library is distributed in the hope that it will be useful, but # WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU # Lesser General Public License for more details. # # You should have received a copy of the GNU Lesser General Public # License along with this library; If not, you may get a copy from: # http://www.opensource.org/licenses/lgpl-license.html # # $Id: ResultViewer.pm,v 1.2 2011/06/16 12:55:13 andrews Exp $ package Bivio::Util::ResultViewer; use strict; use Bivio::Base 'Bivio::ShellUtil'; our($VERSION) = sprintf('%d.%02d', q$Revision: 1.2 $ =~ /\d+/g); my($root) = "$ENV{HOME}/src/perl/$ENV{BROOT}/Test/t"; my($log_dir_name) = $root . '/log'; my($index_page_name) = $log_dir_name . '/index.html'; my($our_name) = __PACKAGE__ =~ /::(\w+)$/; sub USAGE { return <<'EOF'; View acceptance test output in browser usage: b ResultViewer [options] command [args...] commands: generate [test-name ...] -- (re)process results from one or more tests Default is all tests EOF } my($css) = <<'EOF'; EOF my($javascript) = <<'EOF'; EOF my($frameset_html) = <<'EOF'; EOF sub generate { my($self, @names) = (shift, @_); my($dir); opendir($dir, $log_dir_name) || return 'Cannot open directory: ' . $log_dir_name; my(@subdirs)= grep {/^[^.]/ && -d "$log_dir_name/$_"} readdir($dir); closedir($dir); if (int(@names)) { foreach my $name (@names) { return 'no test results for ' . $name unless grep({$name eq $_} @subdirs); } } else { @names = @subdirs; } my($rows) = "Test Name\n"; foreach my $dir (sort(@subdirs)) { $rows .= "$dir\n"; my($err) = _generate_one($self, $dir) if grep({$dir eq $_} @names); return $err if $err; } my $content = < $css Test Results

Test Results

$rows
EOF return _write_file($index_page_name, $content); } sub _generate_one { my($self, $dir) = @_; print "$dir\n"; my($test_dir_name) = $root . '/log/' . $dir; my($gen_dir_name) = $test_dir_name . '/' . $our_name; mkdir($gen_dir_name) || return 'cannot create directory: ' . $gen_dir_name unless -e $gen_dir_name; my(@req_files) = glob($test_dir_name. '/http*.req'); return "$test_dir_name contains no test results" unless int(@req_files); _write_file($gen_dir_name . '/index.html', $frameset_html); _write_panel($gen_dir_name . '/panel.html', $dir); my($html); open($html, '>', $gen_dir_name . '/transactions.html') || return 'cannot open transactions file for: ' . $dir; _write_page_header($html, $dir); foreach my $req_file (@req_files) { my($req_nr) = $req_file =~ /http-(\d+)/; my($res_nr) = sprintf('%05d', $req_nr + 1); my(@req_lines) = _read_file($req_file); my($location) = shift @req_lines; my($req_page_name) = 'request-' . $req_nr . '.txt'; _write_file($gen_dir_name . '/' . $req_page_name, \@req_lines); $location =~ s/^.*?:\s*//; my($cmd) = @req_lines; my($base) = $cmd =~ qr{(http://.*?/)}; my($res_file) = $req_file; $res_file =~ s/http-\d+.req/http-$res_nr.res/; my(@res_lines) = _read_file($res_file); my($sts) = $res_lines[0] =~ /HTTP\/1.1 (\d+).*/; my($nr_empty); my(@headers) = map({$nr_empty++ if $_ eq "\n"; $nr_empty ? () : $_} @res_lines); my(@res_page) = @res_lines; splice(@res_page, 0, int(@headers) + 1); map({$_ =~ s///} @res_page) if $base; my($extension) = $cmd =~ qr{http://.*?/.*?(\..*?)[$\?]}; $extension ||= '.html'; my($res_page_name) = 'response-' . $res_nr . '.html'; _write_file($gen_dir_name . '/' . $res_page_name, \@res_page); _write_page_line($html, $location, int($req_nr), $req_page_name, int($res_nr), $res_page_name, $sts, $cmd); } _write_page_footer($html); close($html); return; } sub _read_file { my($fn) = @_; my($fh); open($fh, '<', $fn) || die('cannot open: ' . $fn); my(@lines) = <$fh>; close($fh); return @lines; } sub _write_file { my($fn, $lines) = @_; my($fh); open($fh, '>', $fn) || return 'cannot open: ' . $fn; print $fh ref($lines) ? @$lines : $lines; close($fh); return; } sub _write_page_footer { my($fh, $name) = @_; print $fh < END return; } sub _write_page_header { my($fh, $name) = @_; print $fh < $css $javascript END return; } sub _write_page_line { my($fh, $location, $req_nr, $req_page_name, $res_nr, $res_page_name, $sts, $cmd) = @_; print $fh < END return; } sub _write_panel { my($fn, $name) = @_; _write_file($fn, << "END"); $css $name

Results for $name

Back to test list
$req_nr/$res_nr $location $sts $cmd
Request Response Number Test Line Number HTTP Status Command
END } 1;