#!/usr/local/bin/perl
#
# Copyright (c) 2002-2004 Eric Wallengren
# This file is part of the Continuous Automated Build and Integration
# Environment (CABIE)
#
# CABIE is distributed under the terms of the GNU General Public
# License version 2 or any later version. See the file COPYING for copying
# permission or http://www.gnu.org.
#
# THIS MATERIAL IS PROVIDED AS IS, WITH ABSOLUTELY NO WARRANTY EXPRESSED OR
# IMPLIED, without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. ANY USE IS AT YOUR OWN RISK.
#
# Permission to modify the code and to distribute modified code is granted,
# provided the above notices are retained, and a notice that the code was
# modified is included with the above copyright notice.
#
#
# use packages...
#
use CGI qw(:all);
use Sys::Hostname;
my $POSIX = 1;
my $hostname = hostname();
my $ostype;
if ($ =~ /MSWin32/) {
$POSIX = 0;
$ostype = "winsys";
} else {
$ostype = "unixsys";
}
BEGIN {push @INC, "./lib";}
require "$ostype.pm";
require "$hostname.pm";
#
# Create an instance of CGI
#
my $query = new CGI;
my $initquery = new CGI;
my $Server;
my $Title;
my $Start;
my @comments;
my @passflag;
my $PDefault;
#
# Create instances of packages...
#
my $config = new $hostname;
my $os = new $ostype;
#
# Use for seeing if a job has exists
#
# OS SPECIFIC
my $Moutdir = $config->JOBDIR;
my $logo = $config->LOGOICON;
#
# Global values for fields...
#
my $Prompt=" Enter comment and click on submit ";
#
# Print content-type info
#
print "Content-type: text/html\n\n";
#
# Print standard information...
#
print <
Enter Comments
EOF
# &gen_values($query);
#
# The main function for rendering job data in a table.
#
&do_work($query);
print "Comments for $Title $Start ";
#
# Generate a form to create a CGI query
#
&print_prompts($query);
#
# Print end of document.
#
print <
EOF
#
# Close file if debugging is on
if ($debug) {
close(DBG);
}
#
# Generate a form for presentation to the user.
#
sub print_prompts {
#
# We need to use this instance of CGI
#
my ($query) = @_;
$Query = $query->param('Query');
#
# Setup a form, and a table withing the form
#
#
# Setup a form, and a table withing the form
#
if ($Server =~ /^$/ || $Title =~ /^$/ ) {
print $query->start_form(-method=>'GET');
print "";
print $query->textarea(-name=>'foo',
-default=>'starting value',
-rows=>10,
-columns=>25);
print " ";
} else {
print "";
print $query->start_form(-method=>'GET');
print $query->textarea(-name=>'Comments',
-default=>"@comments",
-rows=>10,
-columns=>25);
print " ";
}
#
# Create the submit mechanism
#
p();
if ($Server =~ /^$/ || $Title =~ /^$/ ) {
print "";
print $query->submit(-name=>'Query',
-value=>'Submit');
print $query->popup_menu(-name=>'Status',
-values=>['Untested','Passed Test', 'Failed Test'],
-default=>"$PDefault");
print " ";
} else {
print "";
print $query->submit(-name=>'Query',
-value=>'Submit');
print $query->popup_menu(-name=>'Status',
-values=>['Untested', 'Passed Test', 'Failed Test'],
-default=>"$PDefault");
print " ";
}
print $query->hidden(-name=>'hsrvr',
-default=>"$Server");
print $query->hidden(-name=>'htitle',
-default=>"$Title");
print $query->hidden(-name=>'jobno',
-default=>"$Start");
#
# End the form
#
print end_form;
}
sub do_work {
my($query) = @_;
my @hasharray;
my @emptyhash;
my @empty;
my $buildstatus;
$Query = $query->param('Query');
$PassFail = $query->param('Status');
if ($Query =~ /^Submit$/ ) {
#
# Use from a CGI POST
#
$Server = $query->param('hsrvr');
$Title = $query->param('htitle');
$Start = $query->param('jobno');
$Comments= $query->param('Comments');
#
# Grab server, and titles from configuration table
#
$sqlquery = "select comment from comments where binary server=\"$Server\" ";
$sqlquery .= "and binary title=\"$Title\" and job=\"$Start\"";
@comments = $os->run_sql_query("$sqlquery", ";", 0);
if (@comments == 0) {
#
# Grab server, and titles from configuration table
#
push @sqlarray, "$Server";
push @sqlarray, "$Title";
push @sqlarray, "$Start";
push @sqlarray, "$Comments";
if ($Comments !~ /^$/ ) {
if (($os->run_sql_submit("comments", @sqlarray)) == 0) {
print "failed to write record to comments table ";
}
}
@sqlarray = @empty;
} else {
$sqlquery = "update comments set comment=\"$Comments\" ";
$sqlquery .= "where binary server=\"$Server\" and binary title=\"$Title\" ";
$sqlquery .= "and job=\"$Start\"";
@jobnos = $os->run_sql_query("$sqlquery", ";", 0);
}
} else {
#
# Use from a CGI POST
#
$Server = $query->param('srvr');
$Title = $query->param('title');
$Start = $query->param('startjob');
#
# Grab server, and titles from configuration table
#
$sqlquery = "select comment from comments where binary server=\"$Server\" ";
$sqlquery .= "and binary title=\"$Title\" and job=\"$Start\"";
@comments = $os->run_sql_query("$sqlquery", ";", 0);
}
if ($PassFail =~ /^Failed Test$/ ) {
#
# Use from a CGI POST
#
$Server = $query->param('hsrvr');
$Title = $query->param('htitle');
$Start = $query->param('jobno');
$Comments= $query->param('Comments');
$sqlquery = "update jobs set status=\"1\" where binary ";
$sqlquery .= "server=\"$Server\" and binary title=\"$Title\" ";
$sqlquery .= "and job=\"$Start\"";
@passflag = $os->run_sql_query("$sqlquery", ";", 0);
$PDefault = "Failed Test";
}
if ($PassFail =~ /^Passed Test$/ ) {
#
# Use from a CGI POST
#
$buildstatus = jobstatus($Server, $Title, $Start);
if ($buildstatus != 2) {
$Server = $query->param('hsrvr');
$Title = $query->param('htitle');
$Start = $query->param('jobno');
$Comments= $query->param('Comments');
$sqlquery = "update jobs set status=\"3\" where binary ";
$sqlquery .= "server=\"$Server\" and binary title=\"$Title\" ";
$sqlquery .= "and job=\"$Start\"";
@passflag = $os->run_sql_query("$sqlquery", ";", 0);
$PDefault = "Passed Test";
}
}
if ($PassFail =~ /^Untested$/ ) {
#
# Use from a CGI POST
#
$buildstatus = jobstatus($Server, $Title, $Start);
if ($buildstatus != 2) {
$Server = $query->param('hsrvr');
$Title = $query->param('htitle');
$Start = $query->param('jobno');
$Comments= $query->param('Comments');
$sqlquery = "update jobs set status=\"0\" where binary ";
$sqlquery .= "server=\"$Server\" and binary title=\"$Title\" ";
$sqlquery .= "and job=\"$Start\"";
@passflag = $os->run_sql_query("$sqlquery", ";", 0);
$PDefault = "Untested";
}
}
$buildstatus = jobstatus($Server, $Title, $Start);
if ($buildstatus == 0) {
$PDefault = "Untested";
} elsif ($buildstatus == 1) {
$PDefault = "Failed Test";
} elsif ($buildstatus == 3) {
$PDefault = "Passed Test";
}
}
sub jobstatus {
my $Server = shift;
my $Title = shift;
my $Start = shift;
#
# Grab server, and titles from configuration table
#
$sqlquery = "select status from jobs where binary server=\"$Server\" ".
"and binary title=\"$Title\" and job=\"$Start\"";
@passflag = $os->run_sql_query("$sqlquery", ";", 0);
return $passflag[0];
}
#
# Generate readable time string from perl's 'time' function
#
sub _gen_time_string {
my $ts = shift;
my $arg = shift;
my $returnstring;
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
localtime($ts);
if ($arg == 1) {
$returnstring = sprintf("%02d/%02d/%04d\@%02d:%02d:%02d\n", $mon+1,
$mday, 1900 + $year, $hour, $min, $sec);
} else {
$returnstring = sprintf("%02d/%02d/%04d %02d:%02d:%02d\n", $mon+1,
$mday, 1900 + $year, $hour, $min, $sec);
}
return $returnstring;
}
#
# Get a list of all active jobs from the configuration table
# and assign the output to global hashes...
#
sub _get_job_info {
#
# Local vars
#
my $sqlquery;
my @sqlret;
my $line;
#
# Grab server, and titles from configuration table
#
$sqlquery = "select server, title from configuration where state=\"0\"";
# $sqlquery = "select server, title from configuration";
@sqlret = $os->run_sql_query("$sqlquery", ":", 0);
#
# Assign unique identifiers to all hashes...
#
foreach $line (@sqlret) {
$mservjobhash{$line} = "";
my ($server, $title) = split(/:/, $line);
$servhash{$server} = "";
$jobhash{$title} = "";
#
# Create the master server/job hash using a unique identifier
# assign 0 to use later in skipline counter (maybe).
#
# $servjobhash{"$server:$title"} = 0;
}
#
# Assign master hash to multiple hashes for use later
#
%idlehash = %servjobhash;
%statehash = %servjobhash;
}
#
# Debug routine...
#
sub _debug {
my $line = shift;
if ($debug) {
print DBG "$line\n";
}
}
sub _do_popup {
my $string = shift;
my $title = shift;
chomp $string;
chomp $title;
$string =~ s/\n/\/g;
return "onmouseout=kill(); onmouseover=\"pop(\'$string \','#B3AFE9',\'$title\'); return false\"";
}
sub _genchangelist {
my $server = shift;
my $title = shift;
my $browser = shift;
my $startjob = shift;
my $endjob = shift;
my $sortby = shift;
my @sortarray;
my $sqlquery;
my @sqlarray;
my @return;
my $line;
if (!defined($server) || !defined($title) || !defined($browser) || !defined($startjob)){
push @sqlarray, "invalid args for _genchangelist";
return @sqlarray;
}
if (!defined($endjob)) {
$endjob = $startjob;
}
push @sortarray, $startjob;
push @sortarray, $endjob;
if ($sortarray[0] > $sortarray[1]) {
$endjob = $sortarray[0];
$startjob = $sortarray[1];
} else {
$endjob = $sortarray[1];
$startjob = $sortarray[0];
}
push @return, "\n\n";
push @return, "";
push @return, "Job Number ";
push @return, "";
push @return, "User \n ";
push @return, "";
push @return, "Version \n ";
push @return, "";
push @return, "File ";
if (defined($endjob)) {
$sqlquery = "select job,changes from changes where ";
$sqlquery .= "binary server=\"$server\" and binary ";
$sqlquery .= "title=\"$title\" and binary job >=\"$startjob\" and ";
$sqlquery .= "binary job <=\"$endjob\" order by $sortby";
} else {
$sqlquery = "select changes from changes where ";
$sqlquery .= "binary server=\"$server\" and binary ";
$sqlquery .= "title=\"$title\" and job=\"$startjob\" order by $sortby";
}
@sqlarray = $os->run_sql_query("$sqlquery", ",", 0);
@mailto = `cvs -d:pserver:ewallengren:alwaysmake\@source:/src co -p CVSROOT/users`;
foreach $line (@sqlarray) {
my ($job, $info) = split(/,/, $line);
my ($file, $ver, $date, $who) = split(/;/, $info);
my $fileformatted = sprintf("%s ", $file, $ver,
$file);
foreach $entry (@mailto) {
chomp $entry;
($left, $right) = split(/:/, $entry);
if ($who =~ /^$left/) {
$mailform = sprintf ("$who ", $right);
}
}
push @return, " \n";
if (-d "/mnt/dev/builds/$title/$job") {
push @return, "$job $job \n";
}
push @return, "$mailform \n";
push @return, "$ver \n";
push @return, "$fileformatted \n";
push @return, " \n";
}
push @return, "
";
return @return;
}
sub _genbrowserstring {
my $server = shift;
my $title = shift;
my $sqlquery;
my @sqlarray;
if (!defined($server) || !defined($title)) {
push @sqlarray, "invalid args for _genjoblist";
return $sqlarray[0];
}
$sqlquery = "select browserlink from configuration where binary ";
$sqlquery .= "server=\"$server\" and binary title=\"$title\"";
@sqlarray = $os->run_sql_query("$sqlquery", ";", 0);
if (@sqlarray == 0) {
push @sqlarray, "no records found: $server $title";
}
return $sqlarray[0];
}