#!/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"; use cmbroker; # # Create instances of packages... # my $config = new $hostname; my $os = new $ostype; my $cmbroker = new cmbroker; # # Create an instance of CGI # my $query = new CGI; my $initquery = new CGI; # # Use for seeing if a job has exists # # OS SPECIFIC my $Moutdir = $config->JOBDIR; my $Poutdir = $config->PROMOTION; # # Get all icons # my $disicon = $config->DISICON; my $cgibin = $config->CGIBIN; my $logo = $config->LOGOICON; my $greenicon = $config->GREENICON; my $redicon = $config->REDICON; my $yellowicon = $config->YELLOWICON; my $greenicon = $config->GREENICON; my $runicon = $config->RUNICON; my $promoicon = $config->PROMOICON; my $infoicon = $config->INFOICON; my $webserver = $config->WEBSERVER; my $cgibin = $config->CGIBIN; my $p4user = $config->P4USER; my $p4pass = $config->P4PASSWD; my $defect; my @sjobs; my @jobnos; # # Global values for fields... # my $Server; my $HServer; my $Title; my $HTitle; my $Port; my $Client; my $Root; my $Type; my $Tools; my $Keep; my $Comment; my $SCCS; my $Browser; my $State; my $Query; my $nullpattern = ""; my $Prompt=" ". "Defect Search Page"; # # Colors used for genweb # my @colors = qw ( 33cc99 dc1973 FE5066 b9ffb9 ); my @colorsa = qw ( b9ffb9 ff6600 fe5066 ); # # Get the time... # my $now = time(); my $rightnow = _gen_time_string($now, 0); my $debug = 1; my $string; if ($debug) { open (DBG, ">/tmp/debug.out"); } # # Print content-type info # print "Content-type: text/html\n\n"; # # Print standard information... # print < -- CABIE Build Job Information
\"LOGO\"

CABIE - Build Job Information 

$Prompt

EOF &gen_values($query); # # The main function for rendering job data in a table. # @doc = &do_work($query); foreach $l (reverse @doc) { print $l; } # # Generate a form to create a CGI query # &print_prompts($query); # # Print end of document. # print <
   CABIE Copyright © 2002 Eric Wallengren  
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'); # # Print breaks # print "
\n". "
\n"; # # Setup a form, and a table withing the form # print $query->start_form(-method=>'GET'); print $query->table({-border=>1}, # # We want to display fields here # Tr({-align=>LEFT, -valign=>TOP}, [ th(['Defects', 'Information']), td( [ $query->textfield(-name=>'defect', -default=>"$defect", -size=>'40', -maxlength=>'1025'), p('Enter defect number(s) then click on Submit to get a list of job numbers.') ] ), ] ) ); print "
"; # # Create the submit mechanism # print $query->submit(-name=>'Query', -value=>'Submit'); # # End the form # print end_form; } sub do_work { my($query) = @_; my @hasharray; my @emptyhash; my @jobs; my @ret; my @stuff; my @cvsmailto; my @p4mailto; my @mailto; my $mailform; my $numrecs; my %masterlist; my %defecthash; my $prev = ""; my $p4change; my $servercnt = 1; my $titlecnt = 1; my $jobcnt = 1; my $filecnt = 1; my $usercnt = 1; my $port; my $browse; # # Use from a CGI POST # $Defect = $query->param('defect'); $Query = $query->param('Query'); my $defectlist; if ($Query =~ /^Submit$/ ) { $Defect =~ s/[,\:\'\;\t\[\]\.]/ /g; @allfixes = split(/ /,$Defect); foreach $one (@allfixes) { $one =~ s/ //g; if ($one !~ /^$/) { $defecthash{$one} = "" } } foreach $key (keys %defecthash) { if ($key < 4000 || $key >99999) { push @return, "

Invalid defect $key

"; return; } $defectlist .= "$key\|"; } $defectlist =~ s/\|$//g; @searchdefects = split(/\|/, $defectlist); $sqlquery = "select server,title,job,comment from comments where ". "comment rlike \"$defectlist\""; @jobs = $os->run_sql_query("$sqlquery", ";", 0); $numrecs = @jobs; push @return, "\n"; push @return, "\n"; push @return, "\n"; if ($numrecs > 0) { for ($rc = 0; $rc < @jobs; $rc++) { @record = split(/;/,$jobs[$rc]); $masterlist{"$rc"} = "$record[0]:$record[1]:$record[2]"; } $srcroot = '/usr/cvsmount'; foreach $key (keys %masterlist) { ($bldsvr, $title, $job) = split(/:/, $masterlist{$key}); $sqlquery = "select changes from changes where binary ". "server=\"$bldsvr\" and binary ". "title=\"$title\" and job=\"$job\""; @changes = $os->run_sql_query("$sqlquery", ",", 0); $nsqlquery = "select browserlink, sccs, port from jobs where ". "binary title=\"$title\" and binary ". "server=\"$bldsvr\" and job=\"$job\" ". "order by job desc limit 1"; @nsqlarray = $os->run_sql_query($nsqlquery, ","); ($browse, $sccs, $port) = split(/,/, $nsqlarray[0]); foreach $change (@changes) { # print "
change = $change
\n"; ($f,$v,$d,$u) = split(/;/,$change); if ($sccs =~ /^cvs$/ ) { if (! -f "$srcroot/$f,v") { @ret = @emptyarray; } else { @ret = `/usr/local/bin/rlog -N -r$v $srcroot/$f`; } } if ($sccs =~ /^perforce$/ ) { @ret = `/usr/bin/p4 -u $p4user -P $p4pass -p slcdev1.sct.com:1666 describe -s $d`; $p4change = $d; } foreach $d (@searchdefects) { my $wasfound = 0; foreach $searchme (@ret) { chomp $searchme; if ($searchme =~ /$d/) { $wasfound = 1; } } if ($wasfound) { push @stuff, "$d;$bldsvr;$title;$job;$f;$v;$u". ";$p4change;$sccs"; } } } } # # Grab server, and titles from configuration table # $sqlquery = "select job from jobs where binary server=\"$Server\" "; $sqlquery .= "and binary title=\"$Title\" order by job desc"; @jobnos = $os->run_sql_query("$sqlquery", ";", 0); # $browse = _genbrowserstring($Server, $Title); my $prevs; my $prevt; my $prevj; my $prevu; my $didstart = 0; foreach $record (sort @stuff) { push @sorted, $record; } # foreach $one (sort @stuff) { for($reccnt=0; $reccnt<@sorted; $reccnt++) { my $samerec = 0; my $change; my ($d, $s, $t, $j, $f, $v, $u, $changeno, $sccs) = split(/;/,$sorted[$reccnt]); my ($nd, $ns, $nt, $nj, $nf, $nv, $nu, $nchangeno, $nsccs) = split(/;/,$sorted[$reccnt+1]); my $mainj = $j; my $sccscommand = $sccs."_useraddress"; $fulladdress = $cmbroker->$sccscommand($u, $port); ($useraddress, $username) = split(/:/, $fulladdress); $mailform = "$username"; if (!$foobar) { $prev = $d; $foobar=1; } if ($d ne $nd) { if (!$didstart) { $didstart = 1; } else { push @return, "\n"; } push @return, "$mailform". "\n"; $usercnt=1; $sccscommand = $sccs."_formaturl"; $myurl = $cmbroker->$sccscommand($f, $v, $browse, $port); push @return, "$f". "\n"; $newq = "select status from jobs where title=\"$t\" ". "and job=\"$j\""; @newary = $os->run_sql_query("$newq", ",", 0); $st=$newary[0]; if ( -d "$Poutdir/$t/$j" ) { push @return, "". "$j\n"; } elsif (-d "$Moutdir/$t/$j") { push @return, "". "$j\n"; } else { push @return, "". "$j\n"; } $jobcnt=1; push @return, "$t\n"; $titlecnt=1; push @return, "$s". "\n"; $servercnt=1; push @return, "\n"; push @return, "". "User\n"; push @return, "". "File\n"; push @return, "". "Job\n"; push @return, "". "Title\n"; push @return, "". "Server\n"; push @return, "\n"; push @return, "". "". "$d\n"; $prev = $d; $prevs = $s; $prevt = $t; $prevj = $j; $prevu = $u; } else { push @return, "\n"; if ($prevu ne $u) { if ($u ne $nu) { push @return, "$mailform\n"; $prevu = $u; $usercnt=1; } else { $usercnt++; } } else { #push @return, "\n"; $usercnt++; } if ($sccs =~ /^perforce$/ ) { $returnstring = sprintf ("%s\n", $changeno, $f); push @return, $returnstring; # push @return, "$f\n"; } if ($sccs =~ /^cvs$/ ) { #push @return, $returnstring; push @return, "$f\n"; } if ($prevj ne $j) { if ($j ne $nj) { $newq = "select status from jobs where title=\"$t\" "; $newq .= "and job=\"$j\""; @newary = $os->run_sql_query("$newq", ",", 0); $st=$newary[0]; if ( -d "$Poutdir/$t/$j" ) { push @return, "$j\n"; } elsif (-d "$Moutdir/$t/$j") { push @return, "$j\n"; } else { push @return, "$j\n"; } $prevj = $j; $jobcnt=1; } else { $jobcnt++; } } else { #push @return, "\n"; $jobcnt++; } if ($prevt ne $t) { if ($t ne $nt) { push @return, "$t\n"; $prevt = $t; $titlecnt=1; } else { $titlecnt++; } } else { $titlecnt++; #push @return, "\n"; } if ($prevs ne $s) { if ($s ne $ns) { push @return, "d=$d nd=$nd $s\n"; $prevs = $s; $servercnt=1; } else { $servercnt++; } } else { # push @return, "\n"; $servercnt++; } push @return, "\n"; } } #push @return, "\n"; #push @return, "User\n"; #push @return, "File\n"; #push @return, "Job\n"; #push @return, "Title\n"; #push @return, "Server\n"; #push @return, "\n"; #push @return, "$prev\n"; push @return, "\n"; push @return, "\n"; } else { $defectlist =~ s/\|/,/g; push @return, "Defect(s) $defectlist not found in any CM comments"; } } return @return; } # # Get parameters from a 'POST' # sub gen_values { my ($query) = @_; my @emptyarray; $defect = ""; # # read servers and jobs # $defect = $query->param('defect'); } # # 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; } # # 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 true\""; } 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]; } sub _returnsccs { my $server = shift; my $title = shift; my @sqlarray; my $sqlquery; $sqlquery = "select sccs 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]; }