view release on metacpan or  search on metacpan

lib/Test/Smoke/Database/Display.pm  view on Meta::CPAN

#  - Remove ccache info for have less distinct compiler
#  - Add another report to tests
#  - Update FAQ.pod for last Test::Smoke version
#  - Save only wanted headers for each nntp articles (and save From: field).
#  - Move away last varchar field from builds to data
#
# Revision 1.5  2003/08/15 16:08:16  alian
# Display link for X status
#
# Revision 1.4  2003/08/15 15:10:03  alian
# Update html for be able to browse database with lynx
#
# Revision 1.3  2003/08/08 13:58:09  alian
# Update display limit
#
# Revision 1.2  2003/08/06 19:20:51  alian
# Add proto to methods
#
# Revision 1.1  2003/08/06 18:50:42  alian
# New interfaces with DB.pm & Display.pm
#

use Carp;
use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use CGI qw/:standard -no_xhtml/;
use Data::Dumper;
use Carp qw(cluck);
require Exporter;

@ISA = qw(Exporter);
@EXPORT = qw();
$VERSION = ('$Revision: 1.9 $ ' =~ /(\d+\.\d+)/)[0];

use vars qw/$debug $verbose/;

my $limite = 18600;
#$limite = 0;


#------------------------------------------------------------------------------
# new
#------------------------------------------------------------------------------
sub new   {
  my $class = shift;
  my $self = {};
  my $indexer = shift;
  bless $self, $class;
  $debug = ($indexer->{opts}->{debug} ? 1 : 0);
  $verbose = ($indexer->{opts}->{verbose} ? 1 : 0);
  $self->{CGI} = $indexer->{opts}->{cgi};
  $self->{DB} = $indexer->{DB};
  $limite = $indexer->{opts}->{limit};
  $ENV{SCRIPT_NAME}='localhost' if !$ENV{SCRIPT_NAME};
  return $self;
}

#------------------------------------------------------------------------------
# db
#------------------------------------------------------------------------------
sub db(\%) { return $_[0]->{DB}; }

#------------------------------------------------------------------------------
# header
#------------------------------------------------------------------------------
sub header_html(\%) {
  my $self = shift;
  my $u = $self->{opts}->{url_base} || $ENV{BASE} || '/perl/smoke';
  if (!$ENV{SCRIPT_NAME}) {
    $ENV{SCRIPT_NAME} = $ENV{CGI_BASE} || '/cgi-bin';
    $ENV{SCRIPT_NAME}.='/smoke_db.cgi';
  }
  my $buf = start_html
    (-style=>{'src'=>"$u/smokedb.css"}, -title=>"perl-current smoke results");
  $buf.= <<EOF;
 <div class=menubar><table width="100%"><tr><td class=links>&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}">Home</a>&nbsp;|&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}?filter=1">Filter</a>&nbsp;|&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}?last=1">Last report</a>&nbsp;|&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}?last=1;want_smoke=1">Last smoke</a>&nbsp;|&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}?failure=1">
  Last failures</a>&nbsp;|&nbsp;
   <a class=m href="$ENV{SCRIPT_NAME}?smokers=1">
  Smokers</a>&nbsp;|&nbsp;
   <a class=m href="$u/FAQ.html">FAQ</a>&nbsp;|&nbsp;
   <a class=m href="$u/0.html">Stats</a>&nbsp;|&nbsp;
   <a class=m href="http://qa.perl.org">About</a>&nbsp;|&nbsp;
   <a class=m href="mailto:alian\@cpan.org">Author</a>&nbsp;|&nbsp;
</td><td align=right></td></tr></table>
</div>
<h1>Perl-current smoke results</h1>
EOF
  return $buf;

}

#------------------------------------------------------------------------------
# filter
#------------------------------------------------------------------------------
sub filter(\%) {
  my $d = shift;
  my $cgi = $d->{CGI};
  my %t =
    (
     'os'         => '1 - Os',
     'osver'      => '2 - Version OS',
     'archi'      => '3 - Architecture',
     'cc'         => '4 - Compiler',
     'ccver'      => '5 - Compiler version',
     'smoke'      => '6 - Only this smoke',
     'last_smoke' => '7 - Nothing before patchlevel',
     'version'    => '8 - Perl version',
    );
  my $bi = h2("Filter").start_form({-method=>'GET'})."<table border=1><tr>";
  $bi.= hidden({-name=>'last',-value=>1}) if ($cgi->param('last'));
  $bi.= hidden({-name=>'failure',-value=>1}) if ($cgi->param('failure'));
  foreach my $o (sort { $t{$a} cmp $t{$b} } keys %t) {
    $bi.='<tr><td>'.$t{$o}.'</td><td>'.
      "<select name=\"".$o."_fil\"><option value=\"All\">All</option>";
    my $r = $o;
#    print STDERR $r,"\n";

lib/Test/Smoke/Database/Display.pm  view on Meta::CPAN

		     th("Last successfull")),
		  Tr(td($self->db->nb), td($limite),
		     td($lastsmoke),td($lastsuccessful)));
  $summary = $resume.$summary;
  return (\$summary,\$details,\$failure);
}


#------------------------------------------------------------------------------
# smokers
#------------------------------------------------------------------------------
sub smokers {
  my $self = shift;
  my $ref = $self->db->read_smokers;
#      print STDERR Data::Dumper->Dump([$ref]);
  my $buf=Tr(th(cw("Author", 28)), th(cw("Os",7)), th(cw("Os version",16)),
	     th(cw("Architecture",10)), th(cw("Cc",15)),
	     th(cw("Cc version",15)), th(cw("Nb smoke",3)));
  my $i=0;

  # List of config in last 6 month
  # Tab author
  foreach my $author (keys %$ref) {
    my ($bu);
    my $aa = $author;
    $aa=~s/\@/ at /g;
    my ($os, $osver);
    # Tab config
    foreach (@{$ref->{$author}}) {
      $bu = $bu ? td(cw(undef, 28)) : td(cw($aa, 28));
      # tab specs
      $bu.=td(cw(($_->[0] eq $os ? " " : $_->[0]), 7)).
	   td(cw(($_->[1] eq $osver ? " " : $_->[1]), 16)).
	   td(cw($_->[2], 10)).td(cw($_->[3], 15)).
           td(cw($_->[4], 15)). td(cw($_->[5], 3));
      ($os, $osver)  = ($_->[0], $_->[1]);
      $buf.=Tr({-class=>'mod'.$i%2},$bu)."\n";
    }
    $i++;
  }
  $buf = h2("Smokers in last 6 month").
    table({-class => 'box', -border=>1}, $buf);

  # top 20 smokers
  $ref = $self->db->read_top_smokers(20);
  my $bu;
  $buf.=h2("Top 20 smokers since beginning");
  foreach (@$ref) {
    my $author = shift @$_;
    $author=~s/\@/ at /g;
    $bu.=Tr({-class=>'mod'.$i++%2}, td($author), td($_->[0]));
  }
  $buf.=table({-class => 'box', -border=> 1},
	      Tr(th(cw("Author")), th(cw("Nb smoke"))), $bu);
  return $buf
}

#------------------------------------------------------------------------------
# cw
#------------------------------------------------------------------------------
sub cw($$) {
  my ($word, $size)= @_;
  $size = 10 if !$size;
  return ($word || "").(" " x ($size - ($word ? length($word) :0 )));
}

#------------------------------------------------------------------------------
# cn
#------------------------------------------------------------------------------
sub cn($) {
  return ( ($_[0] <10) ? '&nbsp;'.$_[0] : $_[0]);
}

#------------------------------------------------------------------------------
# compl_url
#------------------------------------------------------------------------------
sub compl_url(\%) {
  my $self = shift;
  my $buf;
  foreach ('os','osver','archi','cc','ccver','smoke') {
    $buf.="&$_=".param($_) if (param($_));
  }
  return $buf;
}

__END__

#------------------------------------------------------------------------------
# POD DOC
#------------------------------------------------------------------------------


=head1 NAME

Test::Smoke::Database::Display - HTML display method

=head1 SYNOPSIS

  my $a = new Test::Smoke::Database;
  print $a->HTML->header_html;


=head1 DESCRIPTION

This module give HTML display for Test::Smoke::Database & smoke_db.cgi

=head1 SEE ALSO

L<admin_smokedb>, L<Test::Smoke::Database::FAQ>, L<Test::Smoke::Database>,
L<http://www.alianwebserver.com/perl/smoke/smoke_db.cgi>

=head1 METHODS

=over

=item B<header_html>

Return the HTML menubar that will be displayed in the CGI

=item B<filter>

Return the HTML filter screen.

=item B<display>

Return the main HTML screen with summary

=back

=head2 Private methods