$product

#!/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 Sys::Hostname; use CGI qw(:all); BEGIN{push @INC, "./lib";} # # For loading default package # my $POSIX = 1; my $ospackage; my $hostname = hostname(); if ($ =~ /MSWin32/) { $POSIX = 0; $ospackage = "winsys"; } else { $ospackage = "unixsys"; } use cmbroker; my $cmbroker = new cmbroker; require "$ospackage.pm"; require "$hostname.pm"; # # Create an instance of CGI # my $query = new CGI; my $product = "Continuous Automated Build and Integration Environment"; # # Create instances of packages... # my $config = new $hostname; my $os = new $ospackage; my $refresh = 60; # # 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 $openicon = $config->OPENFOLD; my $closedicon = $config->CLOSEDFOLD; my $promoicon = $config->PROMOICON; my $infoicon = $config->INFOICON; my $webserver = $config->WEBSERVER; my $pwebserver = $config->PWEBSERVER; my $cgibin = $config->CGIBIN; # # Number of seconds in a day... # my $daylen = (60 * 60) * 24; # # Colors used for genweb # my @colorarray = ( "#33cc99", "#dc1973", "#FE5066", "#b9ffb9", "#FFCC00", "#bed2ff", "#669999", "#ff9248" ); # # Global hashes (probably too many)... # my %mainhash; my %abbrhash; # # This is the 'master' hash and will contain all servers and jobs # my %mservjobhash; # # This is the 'slave' hash and will contain only those servers # and jobs selected # my %servjobhash; my %servhash; my %jobhash; my %runjobhash; my %idlehash; my %statehash; my %porthash; my %avghash; my @timearray; my @reversearray; my $bAbb = 0; my $bRet = 0; my $bPro = 0; # # Declared here as globals, but server and job arrays. # my @sservers; my @sjobs; my @serverskip; my %serverskip; my %recordskip; my $GServer; my $GTitle; my $GJob; my $IDLEMSG = "Job Idle"; # # Get the time... # my $now = _get_hosttime(); # my $now = time(); my $rightnow = _gen_time_string($now, 0); my $debug = 1; my $string; if ($debug) { open (DBG, ">/tmp/debug.out"); } # # Populate jobhash... # &gen_values($query); _get_job_info($query); if ($bAbbr) { $IDLEMSG = "Undefined Job"; } # # Print content-type info # print "Content-type: text/html\n\n"; # # Print standard information... # print < EOF # # If no jobs or servers are selectd don't set a refresh # if (!defined($sservers[0]) || !defined(@sjobs[0]) || $refresh == 0) { print "\n"; } else { print "\n"; } # # Pull the style sheet in and finish head, start script and body # print < $product

$\"LOGO\"$

Select the jobs, then the server. Click on Generate Table. Mouse over any icon for additional information.

admin

Key :

$IDLEMSG Syncing Building Overdue Generating Email Build Untested Build Passed Test Build Failed Failed Test

Job # or F - Download Files/View Logs Job # or L - View 'building' Logs U - View Job Update NA - Not Available

Jobnames are linked to build instructions

EOF # # If no servers and no jobs then only print the current time # if (!defined($sservers[0]) || !defined(@sjobs[0])) { print < Time $rightnow EOF } # # Create job array... # foreach $entry (keys %jobhash) { push @jobs, $entry; } # # Create server array... # foreach $entry (keys %servhash) { push @servers, $entry; } # # The main function for rendering job data in a table. # &do_work($query); # # 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) = @_; # # 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}, # caption('Select servers and jobs from the following:'), # # Create the entries we need for this form, servers and jobs # Tr({-align=>LEFT,-valign=>TOP}, [ th(['Jobs', 'Servers', 'Display Format', '# of days to show', 'Refresh Rate']), td( [ $query->scrolling_list(-name=>'jobs', -values=>[sort @jobs], -size=>'10', -defaults=>[@jobs], -multiple=>'true'), $query->scrolling_list(-name=>'servers', -values=>[sort @servers], -size=>'5', -defaults=>[@servers], -multiple=>'true'), $query->checkbox_group(-name=>'display', -values=>['Abbreviated', 'Retired', 'Promoted'], -columns=>1, rows=>3, -linebreak=>'true'), $query->textfield(-name=>'builds', -default=>'1', -override=>1, -size=>4, -maxlength=>4,), $query->textfield(-name=>'refresh', -default=>"$refresh", -override=>1, -size=>4, -maxlength=>4,) ] ) ] ) ); print $query->hidden(-name=>'abbreviated', -default=>"$bAbb"); print $query->hidden(-name=>'retired', -default=>"$bRet"); print $query->hidden(-name=>'promoted', -default=>"$bPro"); # # Break after the table # print "
\n"; # # Create the submit mechanism # print $query->submit(-name=>'submit', -value=>'Generate Table'); # # End the form # print end_form; } sub _vdebug { my $msg = shift; print "

$msg

"; } sub do_work { my($query) = @_; my @hasharray; my @emptyhash; my @rec; my %ignorehash; # my(@values,$key); # # Use from a CGI POST # my $numbuilds = $query->param('builds'); my $numjobs; my $tmpquery; my @tmpquery; my $statement; # # Set a limit for the sql search # my $limitto = $now - ($numbuilds * $daylen); # # We don't want to display stuff without any selections # if (defined($sservers[0]) && defined($sjobs[0])) { # # If this is an abbreviated report the leftmost # column will display jobnames otherwise the left # column will display time... # if ($bAbb) { print "\n". "\n". "\n". "\n"; } else { print "

Jobname

\n". "\n". "\n". "\n"; } # # Create server/job hash specific to this query... # foreach $s (@sservers) { foreach $j (sort @sjobs) { if (defined($mservjobhash{"$s:$j"})) { $servjobhash{"$s:$j"} = 0; } } } # # Get running jobs here # if (!$bPro) { @hasharray = _get_running_jobs(); } if ($bAbb) { foreach $entry (@hasharray) { my @rec = split(/,/,$entry); $ignorehash{"$rec[3]:$rec[4]"} = $rec[0]; } } # # We need to span columns, so search hash for unique server:job pair # foreach $s (@sservers) { # # Server count # $scount = 0; # # Add running jobs last # add_main_hash(@hasharray); # # Grab info for each job from SQL # foreach $j (sort @sjobs) { if (defined($mservjobhash{"$s:$j"})) { # # If we have enabled looking for promoted jobs # if ($bPro) { $tmpquery = "select job from promotion where ". "binary server=\"$s\" and binary ". "title=\"$j\" order by job"; # # If we want an abbreviated view # if ($bAbb) { $tmpquery .= " desc limit 1"; } @tmpquery = $os->run_sql_query("$tmpquery", ",", 1); $statement = ""; for ($i = 1; $i < @tmpquery; $i++) { $statement .= "or job=\"$tmpquery[$i]\" "; } } $sqlquery = "select job, start, end, server, title, ". "status, info from jobs ". "where binary server=\"$s\" and binary "; # # Check to see if this will be abbreviated # then limit to the last job run. # if ($bAbb || $bPro) { if ($bPro) { if (@tmpquery > 1) { $sqlquery .= "title=\"$j\" and ". "job=\"$tmpquery[0]\" $statement"; } else { $sqlquery .= "title=\"$j\" and ". "job=\"$tmpquery[0]\""; } } else { $sqlquery .= "title=\"$j\" order by start desc ". "limit 1"; } } else { $sqlquery .= "title=\"$j\" and start > $limitto ". "order by start desc "; } @sqlarray = $os->run_sql_query("$sqlquery", ",", 1); foreach $line (@sqlarray) { push @results, $line; } # # Increment counters for jobs and servers so that # the table record lines up right. # $scount++; $numjobs++; # # Now we need to get jobstats translated from @results # We need to generate duration, and averages here # and assign to the main hash... # if (@sqlarray > 0) { foreach $sqlline (@sqlarray) { chomp $sqlline; push @hasharray, $sqlline; } } if (!defined($ignorehash{"$s:$j"})) { add_main_hash(@hasharray); } @hasharray = @emptyhash; } } # # Print it up. # if ($scount > 0) { $sqlquery = "select description, port, status ". "from buildservers where binary ". "server=\"$s\""; @sqlarray = $os->run_sql_query("$sqlquery", ":", 1); my ($desc, $port, $stat) = split(/:/, $sqlarray[0]); $porthash{"$s"} = $port; # # If the server's not running... # if ($stat == 0) { $alttxt = "$desc\nStatus: down"; } else { $alttxt = "$desc\nStatus: running on port $port"; } # # Generate the javascript call for server information # $popup = _do_popup($alttxt, "Server Info"); if ($bAbb) { print "\n"; push @serverskip, $s; $serverskip{$s} = 0; } else { print "\n"; } } } print "\n"; print "\n"; if (!$bAbb) { # # Now we need to do the same for jobs... # foreach $s (@sservers) { foreach $j (sort @sjobs) { if (defined($mservjobhash{"$s:$j"})) { $sqlquery = "select state,message from semaphores where ". "binary server=\"$s\" and binary ". "title=\"$j\" order by state desc limit 1"; @sqlarray = $os->run_sql_query("$sqlquery", ",", 1); my ($ST,$MM) = split(/\,/,$sqlarray[0]); # # Need popup here # $string = _do_popup($MM, "Job Disabled"); if ($MM =~ /$j build job disabled/ ) { print "\n"; } else { print "\n"; } } } } } # # Table record end # print "\n"; # # We need to grab job configuration information # foreach $key (keys %servjobhash) { my ($left, $right) = split (/:/, $key); $sqlquery = "select * from configuration where ". "binary server=\"$left\" and binary title ". "=\"$right\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 1); @$key = "$sqlarray[0]"; } foreach $line (sort @results) { push @ordered, "$line"; } @results = reverse @ordered; # # Used for left side of form, start & end times for all jobs # foreach $key (sort keys %mainhash) { push @timearray, $key; } if ($bAbb) { @reversearray = gen_abb_table(); } else { @reversearray = gen_full_table(); } foreach $entry (reverse @reversearray) { print "$entry\n"; } # # End the table... # print "\n". "

Time	\n". "$s\n". "". "\n". "	\n". "$s\n". "". "\n". "
Time	". "". "". "$j	". "$j

\n"; } } # # Generate the main contents of the table, return in a reversed # array... # sub gen_abb_table { # # Declare array. This is for all strings to be returned # in this reversed table (yuuch) # my @array; my $server; my $jobname; # # Number of columns to skip # my $skip = @serverskip; # # Print entries from sorted hash table (sorted by start) # foreach $key (reverse sort keys %mainhash) { if (!defined($recordskip{$key}) && $key !~ /^:$/) { my ($jobname, $server) = split(/:/, $key); my $this = "$server:$jobname"; my $newprintstring; # # Generate the display string to populate the table # record. # $printstring = gen_display_string($key, @$this); # # Push the record on the array # push @array, "\n"; # # Push this onto the array # foreach $sss (reverse @serverskip) { my $that = "$jobname:$sss"; my $what = "$sss:$jobname"; if ($sss !~ $server && defined($mainhash{$that}{finish})) { $recordskip{$that} = 0; $newprintstring = gen_display_string($that, @$what); } if ($server =~ /^$sss$/) { push @array, "$printstring\n"; } else { if ($newprintstring =~ /^\$newprintstring\n"; $newprintstring = ""; } else { push @array, "\n"; } } } $jobinfo = _printjobs($server, $jobname); push @array, "$jobinfo\n"; push @array, "\n"; } } # # Return the array # return @array; } # # Generate the main contents of the table, return in a reversed # array... # sub gen_full_table { # # Declare array. This is for all strings to be returned # in this reversed table (yuuch) # my @array; # # Counter for looking at next enry in time array # $pass = 1; # # Print entries from sorted hash table (sorted by start) # foreach $key (sort keys %mainhash) { # # Increment counters for all jobs, set statehash # foreach $job (keys %servjobhash) { $servjobhash{$job}++; $idlehash{$job}++; } # # Print start time (main entry point into hash) # push @array, "\n"; # # Since there's another has here, read through it... # $a = 1; foreach $entry (reverse sort keys %{ $mainhash{$key} }) { # # This should print out jobname... # if (defined($mainhash{$key}{$entry}{finish})) { $idlehash{$entry} = 1; $statehash{$entry} = 1; # # Grab finish time for use in making an additional # hash table entry # $finishtime = $mainhash{$key}{$entry}{finish}; %{ $mainhash{$finishtime}{$entry}} = ( $key, ); } # # Here's where the nasty stuff starts # foreach $one (keys %{ $mainhash{$key}{$entry} } ) { # # We found the start of the build, time to print skipline info # if (!defined($mainhash{$key}{$entry}{status})) { # # Generate the display string to populate the table # record. # $printstring = gen_display_string($one, @$entry); # # Push this onto the array # push @array, "$printstring\n"; # # Reset build states (we become idle) # $idlehash{$entry} = -1; $statehash{$entry} = 0; } if (defined($mainhash{$key}{$entry}{$one})) { # # If this isn't a 'filler' (status = 99) # if ($mainhash{$key}{$entry}{$one} != 99) { $doskip = 1; } elsif ($statehash{$entry} == 0) { # # Use entries from the array to look at the next entry # to see what the job status is. # $futurestate = _inthefuture($pass, $entry); # # The next time entry has a start for this job, print # skipline info for the accumulated idle entries # if ($futurestate == 1) { $idlehash{$entry}++; push @array, " \n"; } else { # } } } else { # # This is the end of the build, set the skipcounter to 0 # $servjobhash{$entry} = 0; $servjobhash{$entry} = 0; } } # # Here we reset the skipline counter to 0 # if ($doskip == 1) { # # Print skipline, reset counter to 0... # $servjobhash{$entry} = 0; $doskip = 0; } $a++; } # # Generate a string from unx style time for use in the # left column of the table # $showit = _gen_time_string($key,0); # # Push the record on the array # push @array, "$showit\n"; push @array, "\n"; $pass++; } # # Return the array # return @array; } sub gen_display_string { # # This is the main hash reference # my $entry = shift; # # Job information separated by commas # my @JobArg = shift; @jobinfo = split(/,/, $JobArg[0]); # # Make this easy for now and just deal with stuff SQL knows. # my $Server = $jobinfo[0]; my $JobName = $jobinfo[1]; my $Comment = $jobinfo[9]; my $bRunsccs = $jobinfo[10]; my $cgiaccess = $jobinfo[11]; my $depot = $jobinfo[2]; my $sccs; my $browserlink; my $sqlquery; my @sqlarray; my $infostring; my $popupstring; my $ups; my $START; my $FINISH; my $CN; my $STATUS; my $LASTCG; my $AVG; my $bImrunning = 0; my @zstring; # # Assign basic job information # if ($bAbb) { $START = $mainhash{$entry}{start}; $FINISH = $mainhash{$entry}{finish}; $CN = $mainhash{$entry}{jobno}; $STATUS = $mainhash{$entry}{status}; $LASTCG = $mainhash{$entry}{lastcg}; $AVG = $mainhash{$entry}{avg}; } else { $START = $entry; $FINISH = $mainhash{$entry}{"$Server:$JobName"}{finish}; $CN = $mainhash{$entry}{"$Server:$JobName"}{jobno}; $STATUS = $mainhash{$entry}{"$Server:$JobName"}{status}; $LASTCG = $mainhash{$entry}{"$Server:$JobName"}{lastcg}; $AVG = $mainhash{$entry}{"$Server:$JobName"}{avg}; } # # We'll look for an sccs entry in the jobs table and use that # sccs system since we may change CM systems otherwise the job # is running and we'll take the default from the configuration # table. # $sqlquery = "select sccs, browserlink from jobs where binary ". "server=\"$Server\" and binary title=\"$JobName\" ". "and job=\"$CN\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 1); if (@sqlarray == 0) { $sccs =$bRunsccs; } else { ($sccs, $browserlink) = split(/,/, $sqlarray[0]); $cgiaccess = $browserlink; } # # Create readable time strings... # my $startstring = _gen_time_string($START,0); my $finishstring = _gen_time_string($FINISH,0); # # Create a readable string for elapsed time of a build # my $elapsed = _format_elapsed_time($FINISH - $START); # # Setup a default icon for display # my $finishimage = "$runicon"; # # Grab the right sccs icon from buildconf # my $sccssystem = uc("$sccs"); my $sccsicon = $config->{$sccssystem}; # # If this job has completed building # if (($STATUS == 0) || ($STATUS == 1) || ($STATUS == 2) || ($STATUS == 3)) { $ttotalstring = "Total: $elapsed"; $tfinishstring = "Finish: $finishstring"; # # See if the job directory exists... # if (-d "$Moutdir/$JobName/$CN") { my @fullcn = split(/\./, $CN); my $numcn = @fullcn; $tlogstring = "". "$fullcn[$numcn-1]\n"; } else { $tlogstring = "NA "; } # # Make sure there's no assignment to this string already # $trunstring = ""; # # 1 means the build didn't pass testing # 2 means the build failed # 0 means the build and testing passed # if ($STATUS == 1) { $finishimage = "$yellowicon"; } elsif ($STATUS == 2 ) { $finishimage = "$redicon"; } else { $finishimage = "$greenicon"; } } else { # # Make sure these strings are blank # $tlogstring = ""; $trunstring = ""; # # Since we don't have a status 0, 1 or 2, see what's # going on with the job # @running = build_message($Server, $JobName); if (defined($running[0])) { $trunstring = "\nProgress: "."$running[0]"; chomp $trunstring; $bImrunning=1; # # If the build is running, setup appropriate link for reading # running build log. # if ($STATUS == 5) { my @fullcn = split(/\./, $CN); my $numcn = @fullcn; $tnc = $fullcn[$numcn-1]; $tnc =~ s/F/L/g; if ($running[0] =~ /retail/ ) { $tlogstring = "". "$tnc\n" } elsif ($running[0] =~ /debug/ ) { $tlogstring = "". "$tnc\n" } $refline = "U\n"; } # # Need to find out remaining time (or overdue) of a job # $tfinishstring = "Elapsed: $elapsed\n"; my $AVERAGE = _get_average($Server, $JobName); my $remain = $AVERAGE - ($FINISH - $START); # # If the job is overdue show how long overdue it is. # if ($remain < 0) { $bImrunning = 2; $byhowlong = _format_elapsed_time(($FINISH - $START) - $AVERAGE); if ($bAbb) { $mainhash{$entry}{status} = 7; } else { $mainhash{$entry}{"$Server:$JobName"}{status} = 7; } $ttotalstring = "Overdue: $byhowlong"; } else { # # Show remaining time for a job in progress. # my $remainder = _format_elapsed_time($remain); $ttotalstring = "TIME LEFT: $remainder"; } } } # # Get rid of newline... # chomp $ttotalstring; chomp $tfinishstring; chomp $startstring; $sccscommand = $sccs."_identity"; $formattedcgi = $cmbroker->$sccscommand($CN, $depot, $cgiaccess); $sqlquery = "select at, bywhom, comment from promotion ". "where binary server=\"$Server\" and binary ". "title=\"$JobName\" and job=\"$CN\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { foreach $sqlline (@sqlarray) { @queryarray = split(/;/, $sqlline); } # # See if the job directory exists... # if (-d "$Poutdir/$JobName/$CN") { my @fullcn = split(/\./, $CN); my $numcn = @fullcn; $tlogstring = "". "$fullcn[$numcn-1]\n"; } else { $tlogstring = "NA "; # $tlogstring = "$tnc\n"; } $promoline = "Promoted at : $queryarray[0]\n". "Promoted by : $queryarray[1]\n". "Comment : $queryarray[2]"; $promopop = _do_popup($promoline, "Promotion Info"); $promotestring = " ". "

"; } else { $promotestring = ""; } # # If this job has completed building # if (($STATUS == 0) || ($STATUS == 1) || ($STATUS == 2) ||($STATUS == 3)) { $GServer = $Server; $GTitle = $JobName; $GJob = $CN; my $testquery; my @testarray; $sqlquery = "select comment from comments ". "where binary server=\"$Server\" and binary ". "title=\"$JobName\" and job=\"$CN\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); my $smoked = _gettests($JobName, $CN); if (@sqlarray > 0) { $commentpop = _do_popup2("$sqlarray[0]\n$smoked", "Build Comment"); $popupstring = _do_popupstring("/cgi-bin/gencomment", $GServer, $GTitle, $GJob); $infostring = "". "

"; } else { $commentpop = _do_popup2("Click to enter comments for this ". "build.$smoked", "Enter Comment"); $popupstring = _do_popupstring("/cgi-bin/gencomment", $GServer, $GTitle, $GJob); $infostring = "". "

"; } } $identity = $cmbroker->$sccscommand($CN,$depot); $altline = "Jobname : $JobName\n". "Build Server : $Server\n". "Comment : $Comment\n". "Job Identifier : $CN\n". "Start : $startstring\n". "$tfinishstring\n". "$ttotalstring". "$trunstring"; $popstring = _do_popup($altline, "Job Info"); $sccspop = _do_popup($identity, "CM Info"); if ($bImrunning == 1) { @zstring = split(/TIME LEFT: /, $ttotalstring); } elsif ($bImrunning == 2) { @zstring = split(/Overdue: /, $ttotalstring); } else { $refline = "U "; } return $tlogstring. $refline. "
". "". "

". "". $infostring. " ". "

". "". $promotestring. "
".$zstring[1]. "\n"; } sub _gettests { my $jobname = shift; my $job = shift; my $sqlquery; my @sqlarray; my $return; my $recs; $sqlquery = "select title from results where binary job=\"$job\" ". "and binary jobname=\"$jobname\""; @sqlarray = $os->run_sql_query($sqlquery, ";"); $recs = @sqlarray; if ($recs) { $return = "". "". "". "". "". "". ""; foreach my $entry (@sqlarray) { my $testquery; my @testarray; my $pl; $return .= ""; $testquery = "select deployto, platform, comment from ". "testconfiguration where binary title=\"$entry\""; @testarray = $os->run_sql_query($testquery, ";"); my ($d, $p, $c) = split(/;/, $testarray[0]); if ($p =~ /sol/) { $pl = "solaris"; } $return .= "". "". "". "". ""; } $return .= "". "

Build #	Test	Server	Platform
$job	$entry	$d	$pl

"; } return $return; } # # Add entries from SQL query to hash table making sure that unique # information is not lost. This preserves a beginning of record - # as in the case where jobs fire off simultaneously - so that multiple # jobs with the same start time end up being preserved in the mainhash. # sub add_main_hash { # # Read the arg array (SQL records sent) # my @array = @_; my @sqlarray; # # We want to create an 'average time' so that estimates for # job completion can be displayed or overdue jobs can be # properly displayed # my $avg; # # Used for division in generation of averages... # my $rec = 0; # # Read through each line in the array, split by comma and assign # to a record array as follows: # # 0 = jobno # 1 = start # 2 = finish # 3 = server # 4 = job # 5 = completion status # 6 = last change (not supported by all sccs) # 7 = Average time # foreach $line (@array) { @rec = split (/,/, $line); # # Increment record counter, then increment average counter # $rec++; $avg += ($rec[2] - $rec[1]); } $sqlquery = "select avg(end-start) from jobs where binary ". "server=\"$rec[3]\" and binary title=\"$rec[4]\""; @sqlarray = $os->run_sql_query("$sqlquery", " ", 0); my $avvvg = 0; # my $avvvg = _get_average($rec[3], $rec[4]); # # Generate the average here # #if ($rec > 0) { # $avg = sprintf ("%d", $avg / $rec); #} print DBG "$avgtot div $avgarray[0]\n"; $avg = sprintf("%d", $avvvg); # $avg = sprintf("%d", $sqlarray[0]); $avghash{"$rec[3]:$rec[4]"} = $avg; # # Wish I didn't have to read through this twice, but here's # where I can assign each record to a pretty deep hash. I # needed the average before I could proceed... # foreach $line (@array) { # # Split the line up and assign to an array. # @rec = split (/,/, $line); # # This hash is unique by start server:job # if ($bAbb) { %{ $mainhash{"$rec[4]:$rec[3]"} } = ( jobno => $rec[0], length => $rec[2]-$rec[1], start => $rec[1], finish => $rec[2], avg => $avghash{"$rec[3]:$rec[4]"}, status => $rec[5], lastcg => $rec[6], ); } else { if ("$rec[4]:$rec[3]" !~ /^:$/) { %{ $mainhash{$rec[1]}{"$rec[3]:$rec[4]"} } = ( jobno => $rec[0], length => $rec[2]-$rec[1], finish => $rec[2], avg => $avghash{"$rec[3]:$rec[4]"}, status => $rec[5], lastcg => $rec[6], ); } } if ($bAbbr) { $abbrhash{"$rec[3]:$rec[4]"} = ""; } # # If there's a finish field in the record # we'll create an addition to the hash to track # status of all jobs (idle in most cases...) # if (!$bAbb) { if (defined($rec[2])) { foreach $job (keys %servjobhash) { %{ $mainhash{$rec[2]}{$job} } = ( status => 99, ); } # # Remove status = 99 for a non-idle job... # if (defined($mainhash{$rec[2]}{"$rec[3]:$rec[4]"}{status})) { delete ($mainhash{$rec[2]}{"$rec[3]:$rec[4]"}{status}); } # # Create a crude pointer to the previous (next) record # (depending on how you look at it) # %{ $mainhash{$rec[2]}{"$rec[3]:$rec[4]"} } = ( $rec[1], ); } } # # Create idle hashes for idle jobs # if (!$bAbb) { foreach $job (keys %servjobhash) { # # There's no jobno for jobs with a start time, set status # if (!defined($mainhash{$rec[1]}{$job}{jobno})) { %{ $mainhash{$rec[1]}{$job} } = ( status => 99, ); } } } } # # Assign initial values to state hash # foreach $job (keys %servjobhash) { $statehash{$job} = 0; } } # # Get parameters from a 'POST' # sub gen_values { my ($query) = @_; my @emptyarray; my @display; my $afound = 0; my $rfound = 0; my $pfound = 0; @sservers = @emptyarray; @sjobs = @emptyarray; # # read servers and jobs # @sservers = $query->param('servers'); @sjobs = $query->param('jobs'); @display = $query->param('display'); $refresh = $query->param('refresh'); if (!defined($refresh)) { $refresh = 60; } foreach $entry (@display) { if ($entry =~ /^Abbreviated/ ) { $bAbb = 1; $afound = 1; } if ($entry =~ /^Retired/) { $bRet = 1; $rfound = 1; } if ($entry =~ /^Promoted/) { $bPro = 1; $pfound = 1; } } if ($afound) { $query->param('abbreviated', '1'); } else { $query->param('abbreviated', '0'); } if ($rfound) { $query->param('retired', '1'); } else { $query->param('retired', '0'); } if ($pfound) { $query->param('promoted', '1'); } else { $query->param('promoted', '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; my $bretired = $query->param('retired'); # # Grab server, and titles from configuration table # if ($bretired) { $sqlquery = "select server, title from configuration"; } else { $sqlquery = "select server, title from configuration where ". "state=\"0\""; } @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"; } } # # Routine to format elapsed time of a build # sub _format_elapsed_time { my $difference = shift; my $seconds = $difference % 60; my $difference = ($difference - $seconds) / 60; my $minutes = $difference % 60; my $difference = ($difference - $minutes) / 60; my $hours = $difference % 24; my $difference = ($difference - $hours) / 24; my $days = $difference % 7; my $weeks = ($difference - $days) / 7; my $returnstring = sprintf("%02d:%02d:%02d", $hours, $minutes,$seconds); return $returnstring; } sub build_message { my $server = shift; my $title = shift; my $line; # SQL Stuff... my $sqlquery; my @sqlarray; my @sqlarray2; $sqlquery = "select state from semaphores where ". "binary server=\"$server\" and binary ". "title=\"$title\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray > 0) { $sqlquery = "select message from joblog where ". "binary server=\"$server\" and binary ". "title=\"$title\" order by step desc limit 1"; @sqlarray2 = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray2 > 0) { $line = $sqlarray2[0]; } } else { return undef; } chomp $line; return $line; } sub build_status { my $server = shift; my $title = shift; my $line; # SQL Stuff... my $sqlquery; my @sqlarray; my @sqlarray2; $sqlquery = "select state from semaphores where ". "binary server=\"$server\" and binary ". "title=\"$title\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray > 0) { $sqlquery = "select step from joblog where ". "binary server=\"$server\" and binary ". "title=\"$title\" order by step desc limit 1"; @sqlarray2 = $os->run_sql_query("$sqlquery", ",", 0); if (@sqlarray2 > 0) { $line = $sqlarray2[0]; } } else { return undef; } chomp $line; return $line; } # # Get the job state # sub _get_job_state { my $server = shift; my $jobname = shift; my @state; my @Contents; my $entries; my @Readit; my $buildnum; my $idx; my $jobline; my $message; $jobline = build_status($server, $jobname); $message = build_message($server, $jobname); $entries = @Contents; if ($jobline == 0) { @Readit = split(/ /,$message); push @state, $Readit[2]; push @state, "4"; } elsif ($jobline == 1) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "4"; } elsif (($jobline == 2 ) || ($jobline == 3) || ($jobline == 4) || ($jobline == 5)) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "5"; } elsif ($jobline == 6) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "6"; } elsif ($jobline == 7) { @Readit = split(/ /,$message); $idx = index($Readit[0], "\."); $buildnum = substr($Readit[0],$idx+1); push @state, $buildnum; push @state, "0"; } return @state; } sub _inthefuture { my $recno = shift; my $name = shift; my $ret = 0; if (!defined($timearray[$recno])) { $ret = 1; } if (defined($mainhash{$timearray[$recno]}{$name}{finish})) { $ret = 1; } return $ret; } # # Generate a list of running jobs # sub _get_running_jobs { # # Declare boolean value # my $running; # # Declare what's going to be returned... # my @returnarray; foreach $s (@sservers) { foreach $j (@sjobs) { $running = 0; $sqlquery = "select message from semaphores where ". "binary server=\"$s\" and binary ". "title=\"$j\" and state=\"1\""; @sqlarray = $os->run_sql_query("$sqlquery", ";", 0); if (@sqlarray > 0) { if ($sqlarray[0] !~ /build job disabled/) { $running = 1; @info = split(/ /, $sqlarray[0]); } } if ($running == 1) { $sqlquery = "select time from semaphores where ". "binary server=\"$s\" and binary ". "title=\"$j\" and state=\"1\""; @TimeArray = $os->run_sql_query("$sqlquery", ";", 0); $sqlquery = "select avg(end-start) from jobs where binary ". "server=\"$s\" and binary title=\"$j\""; @sqlarray = $os->run_sql_query("$sqlquery", " ", 0); $difference = $now - $TimeArray[0]; @state = _get_job_state($s, $j); push @returnarray, "$info[1],$TimeArray[0],$now,$s,$j,". "$state[1]"; } } } return @returnarray; } sub _do_popupstring { my $webserver = shift; my $server = shift; my $title = shift; my $jobno = shift; return "\"javascript:loadpopup(\'$webserver\',\'$server\',\'$title\',". "\'$jobno\');\""; } 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 _do_popup2 { my $string = shift; my $title = shift; chomp $title; # $string =~ s/\n/\/g; @newstring = split(/\n/, $string); $string = ""; foreach $entry (@newstring) { chomp $entry; $string .= "$entry
"; $string =~ s/\r//g; } return "onmouseout=kill(); onmouseover=\"pop(\'$string\','#B3AFE9',\'$title\'); return false\""; } sub _printjobs { my $s = shift; my $j = shift; my $return; if (defined($mservjobhash{"$s:$j"})) { $sqlquery = "select message from semaphores where ". "binary server=\"$s\" and binary ". "title=\"$j\""; @sqlarray = $os->run_sql_query("$sqlquery", ",", 1); # # Need popup here # $string = _do_popup($sqlarray[0], "Job Disabled"); if ($sqlarray[0] =~ /$j build job disabled/) { $return = "". "". "

". "". "$j\n"; } else { $return = "". "". "$j\n"; } } return $return; } sub _get_average { my $server = shift; my $title = shift; my $total = 0; my $keep; my $sqlquery; my @sqlarray; my $line; $sqlquery = "select keeplevel from configuration where binary ". "title=\"$title\" and binary server=\"$server\""; @sqlarray = $os->run_sql_query($sqlquery, ";", 0); $keep = $sqlarray[0]; $sqlquery = "select start,end from jobs where binary ". "title=\"$title\" and binary server=\"$server\" ". "and status!=\"2\" ". "order by job desc limit $keep"; @sqlarray = $os->run_sql_query($sqlquery, ";", 0); $max = 0; foreach $line (@sqlarray) { ($start, $end) = split(/;/, $line); $elapsed = $end-$start; if ($elapsed > $max) { $max = $elapsed; } } if (@sqlarray > 0) { return $max; } else { return 0; } } sub _get_hosttime { my $sqlquery = "select unix_timestamp()"; my @sqlarray = $os->run_sql_query($sqlquery, ";"); return $sqlarray[0]; }