- #!/usr/bin/perl -w
- # -*- perl -*-
- use P4CGI ;
- use strict ;
- #
- #################################################################
- # CONFIGURATION INFORMATION
- # All config info should be in P4CGI.pm
- #
- #################################################################
- #
- # P4 change browser
- # Depot statistics
- #
- #################################################################
- #######
- # Parameters:
- #
- ######
- $| = 1 ;
- #
- # Get parameter(s)
- #
- my $FSPC = &P4CGI::cgi()->param("FSPC") ;
- $FSPC = "//..." unless defined $FSPC ;
- $FSPC = &P4CGI::htmlEncode($FSPC) ;
- my @FSPC = split(/\s*\+?\s*(?=\/\/)/,$FSPC) ;
- $FSPC = "<tt>".join("</tt> and <tt>",@FSPC)."</tt>" ;
- my $FSPCcmd = "\"" . join("\" \"",@FSPC) . "\"" ;
- ###
- ### subroutine findTime
- ### A (really) poor mans version of mktime(3).
- ### Parameters: year,month,day,hour,min
- ### Returns: time_t value that corresponds to above result (almost)
- sub findTime($$$$$)
- {
- my ($iyear,$imon,$iday,$ihour,$imin) = @_ ;
- $iyear -= 1900 ;
- $imon-- ;
- my $time = time() ;
- my $delta = int($time/2)+1 ;
- my $lastsgn = -1 ;
- my $n = 300 ;
- while($delta > 10) {
- last if $n-- == 0 ;
- my $sgn = 1 ;
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time) ;
- my $i = ((((((((($iyear * 12) + $imon) * 32) + $iday) * 24) + $ihour) * 60) + $imin) * 60) + 30 ;
- my $o = ((((((((($year * 12) + $mon) * 32) + $mday) * 24) + $hour) * 60) + $min) * 60) + $sec ;
- last if $i == $o ;
- $sgn = -1 if $i < $o ;
- $time += ($sgn * $delta) ;
- $delta = int(($delta+1)/2) ;
- $lastsgn = $sgn ;
- }
- return $time ;
- } ;
- &P4CGI::SET_HELP_TARGET("DepotStats") ;
- my $title =
- "Depot Statistics for<br><tt>" .
- join("<br></tt>and<tt><br>\n",@FSPC) . "</tt> and user " . &P4CGI::P4_USER() ;
- print &P4CGI::start_page("") ;
- sub printStat($$) {
- my $prompt = shift @_ ;
- my $data = shift @_ ;
- &P4CGI::table_row({-type => "td",
- -class => "\"Prompt\"",
- -text => "$prompt:"},
- $data) ;
- };
- "<br>",
- &P4CGI::start_framedTable("Depot statistics"),
- &P4CGI::start_table() ;
- {
- my @counters ;
- &P4CGI::p4call(\@counters,"counters") ;
- # printStat("P4 counters","") ;
- foreach (@counters) {
- s/(\S+) = /P4 $1 counter = / ;
- &printStat(split(" = ","$_")) ;
- }
- }
- # Users
- my %userCvt ;
- &P4CGI::p4user2name(\%userCvt) ;
- my @users = keys %userCvt ;
- printStat("Users",@users) ;
- # Clients
- my %clients = &P4CGI::p4clients() ;
- printStat("Clients",scalar(keys %clients)) ;
- # Labels
- my @labels ;
- &P4CGI::p4call(\@labels,"labels") ;
- printStat("Labels",@labels) ;
- # branches
- my @branches ;
- &P4CGI::p4call(\@branches,"branches") ;
- printStat("Branches",@branches) ;
- # jobs
- my @jobs ;
- &P4CGI::p4call(\@jobs,"jobs") ;
- printStat("Jobs",@jobs) ;
- &P4CGI::end_table(),
- &P4CGI::end_framedTable() ;
- # Get changes
- my @changes ;
- &P4CGI::p4call(\@changes,"changes -s submitted $FSPCcmd") ;
- # Sort and remove duplicates
- {
- my @ch = sort { $a =~ /Change (\d+)/ ; my $ac = $1 ;
- $b =~ /Change (\d+)/ ; my $bc = $1 ;
- $bc <=> $ac } @changes ;
- my $last="" ;
- @changes = grep {my $l = $last ;
- $last = $_ ;
- $_ ne $l } @ch ;
- }
- ## File list stats
- "<br>",
- &P4CGI::start_framedTable("Statistics for \"$FSPC\" and user " . &P4CGI::P4_USER() ),
- &P4CGI::start_table("") ;
- printStat("Submitted changes",scalar @changes) ;
- # Data about first submit
- my $first = pop @changes ;
- push @changes,$first ;
- $first =~ s/Change (\d+).*/$1/ ;
- my %data ;
- my $firstTime = 0;
- my $firstDate = "";
- my $daysSinceFirstSubmit = 0 ;
- &P4CGI::p4readform("change -o $first",\%data) ;
- if(exists $data{"Date"}) {
- $firstDate = $data{"Date"} ;
- if($data{"Date"} =~ /(\d+).(\d+).(\d+).(\d+).(\d+)/) {
- $firstTime = findTime($1,$2,$3,$4,$5) ;
- my $seconds = time() - $firstTime ;
- $daysSinceFirstSubmit = int($seconds/(24*3600)) ;
- }
- }
- # Last submit
- my $last = shift @changes ;
- unshift @changes,$last ;
- $last =~ s/Change (\d+).*/$1/ ;
- my $lastTime=0 ;
- my $lastDate="" ;
- my $daysSinceLastSubmit=0 ;
- &P4CGI::p4readform("change -o $last",\%data) ;
- if(exists $data{"Date"}) {
- $lastDate = $data{"Date"} ;
- if($data{"Date"} =~ /(\d+).(\d+).(\d+).(\d+).(\d+)/) {
- $lastTime = findTime($1,$2,$3,$4,$5) ;
- my $seconds = time() - $lastTime ;
- $daysSinceLastSubmit = int($seconds/(24*3600)) ;
- }
- } ;
- printStat("First submit","$first ($firstDate)") ;
- printStat("Latest submit","$last ($lastDate)") ;
- printStat("Days between first and latest submit",$daysSinceFirstSubmit-$daysSinceLastSubmit) ;
- if(($daysSinceFirstSubmit-$daysSinceLastSubmit) > 0) {
- printStat("Average submits per day",
- sprintf("%.2f",@changes/($daysSinceFirstSubmit-$daysSinceLastSubmit))) ;
- };
- # Read and parse file list
- my $files=0 ;
- my $deletedFiles=0 ;
- my %revlevels ;
- my $maxrevlevel=0 ;
- my $totrevs=0 ;
- my $file ;
- foreach $file (@FSPC) {
- local *F ;
- &P4CGI::p4call(*F,"files \"$file\"") ;
- while(<F>) {
- $files++ ;
- /\#(\d+) - (\S+)/ ;
- my ($r,$s) = ($1,$2) ;
- $deletedFiles++ if $s eq "delete" ;
- $totrevs += $r ;
- $maxrevlevel = $r if $r > $maxrevlevel ;
- $revlevels{$r} = 0 unless exists $revlevels{$r} ;
- $revlevels{$r}++ ;
- }
- close F ;
- }
- printStat("Current number of files",$files) ;
- printStat("Deleted files",$deletedFiles) ;
- printStat("Average revision level for files ",sprintf("%.2f",$totrevs/$files)) ;
- printStat("Max revision level",$maxrevlevel) ;
- &P4CGI::end_table(),
- &P4CGI::end_framedTable() ;
- # File revision statistics
- # "<a name=\"revstat\"><hr></a>",
- # &P4CGI::start_table("width=90%"),
- # &P4CGI::table_row(-type=>"th",
- # undef,
- # undef,
- # "File Revision Statistics"),
- # &P4CGI::table_row({-type=>"th",
- # -text => "Revision Level",
- # -width => "20%",
- # -align => "right"},
- # {-text => "No. of<br>files",
- # -type=>"th",
- # -width => "10%"},
- # {-text => " ",
- # -bgcolor=>&P4CGI::BGCOLOR()}),
- # &P4CGI::end_table() ;
- #
- #my $max = 0 ;
- #
- #foreach (keys %revlevels) {
- # $max = $revlevels{$_} if $max < $revlevels{$_} ;
- #} ;
- #
- # my $rev=$maxrevlevel ;
- # while($rev > 0) {
- # my $n = 0 ;
- # $n = $revlevels{$rev} if exists $revlevels{$rev} ;
- # my $w = int((65.0 * $n)/$max) ;
- # if($w == 0) { $w = 1 ; } ;
- # &P4CGI::start_table("colums=4 width=90% cellspacing=0"),
- # &P4CGI::table_row({-text => "$rev",
- # -width => "20%",
- # -align => "right"},
- # {-text => $n==0?"-":"$n",
- # -align => "center",
- # -width => "10%"},
- # {-text => " ",
- # -bgcolor => $n!=0?"blue":"white",
- # -width => "$w\%"},
- # {-text => " ",
- # -bgcolor=>&P4CGI::BGCOLOR()}) ;
- # print &P4CGI::end_table() ;
- # $rev-- ;
- # }
- my %dailySubStat ;
- my %userSubStat ;
- my $n ;
- #my $time = time() ;
- my $time = $lastTime ;
- my $ONE_DAY=3600*24 ;
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
- while($wday != 0) {
- $time -= $ONE_DAY ;
- ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
- }
- sub getNextDate() {
- my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($time);
- $time -= $ONE_DAY * 7 ;
- my $day = sprintf("%4d/%02.2d/%02.2d",$year + 1900, $mon + 1, $mday) ;
- $dailySubStat{$day} = 0 ;
- return $day ;
- } ;
- # Read and parse change list
- my $day = getNextDate() ;
- my $max = 0 ;
- while(@changes > 0) {
- $_ = shift @changes ;
- if(/Change \d+ on (\S+) by (\S+)\@/) {
- my $d = $1 ;
- my $user = $2 ;
- while($d lt $day) {
- $day = getNextDate() ;
- }
- $dailySubStat{$day}++ ;
- $max = $dailySubStat{$day} if $dailySubStat{$day} > $max ;
- $userSubStat{$user} = 0 unless exists $userSubStat{$user} ;
- $userSubStat{$user}++ ;
- }
- }
- # Weekly Submit Statistics
- my $DATE_WIDTH="8em" ;
- my $CNT_WIDTH="5em" ;
- print "<br>",
- &P4CGI::start_framedTable("Weekly Submit Rate","WideFrame"),
- &P4CGI::start_table("colums=\"4\" style=\"width: 100% ; border-collapse: collapse ; \""),
- &P4CGI::table_row({-type=>"th",
- -text => "Week starting",
- -style => "width: $DATE_WIDTH ;"},
- {-text => "submits",
- -type=>"th",
- -style => "width: $CNT_WIDTH ;"},
- " ",
- " "),
- &P4CGI::end_table() ;
- my $d ;
- foreach $d (sort { $b cmp $a } keys %dailySubStat) {
- print &P4CGI::start_table("colums=\"3\" style=\"width: 100% ; border-collapse: collapse ; \"") ;
- my $n = $dailySubStat{$d} ;
- my $w = ((100.0 * $n)/$max) ;
- # if($w == 0) { $w = 1 ; } ;
- my $bgcol = "" ;
- if($n>0) {
- $bgcol="background-color: blue ;" ;
- } ;
- print &P4CGI::table_row({-text => "$d",
- -style => "width: $DATE_WIDTH ; text-align: center ;",
- -align => "right"},
- {-text => $n==0?"-":"$n",
- -align => "center",
- -style => "width: $CNT_WIDTH ;"},
- "<table style=\"border-collapse: collapse ; width: 100% ;\">\n".
- " <tr><td style=\"width: $w\% ; height: 1em; $bgcol\"></td><td></td></tr>\n".
- "</table>\n") ;
- print &P4CGI::end_table() ;
- }
- print &P4CGI::end_framedTable() ;
- my $maxuserlen=0 ;
- my $ul = 10 ;
- map { $ul = length($_) + length($userCvt{$_}) + 5 ;
- $maxuserlen = $ul if $ul > $maxuserlen ; } keys %userCvt ;
- #map { $maxuserlen = length if length > $maxuserlen ; } values %userCvt ;
- #map { $maxuserlen = 5 + length if (3 + length) > $maxuserlen ; } keys %userCvt ;
- $maxuserlen/=2 ;
- # Submits per user
- my $NAME_WIDTH="${maxuserlen}em" ;
- $CNT_WIDTH="$CNT_WIDTH " ;
- print "<br>",
- &P4CGI::start_framedTable("Submits by user","WideFrame"),
- &P4CGI::start_table("style=\"width=100% ; border-collapse: collapse ;\""),
- &P4CGI::table_row({-type=>"th",
- -text => "User",
- -style => "width: $NAME_WIDTH; text-align: center;"},
- {-text => "Submits",
- -type=>"th",
- -style => "width: $CNT_WIDTH; "},
- " ",
- ""),
- &P4CGI::end_table() ;
- my $u ;
- $max = 0 ;
- foreach $u (sort {$userSubStat{$b} <=> $userSubStat{$a} ; } keys %userSubStat) {
- my $n = $userSubStat{$u} ;
- $max = $n if $max == 0 ;
- my $w = ((100.0 * $n)/$max) ;
- # if($w == 0) { $w = 1 ; } ;
- if(exists $userCvt{$u}) {
- my $fullUser = $u . " ($userCvt{$u}}" ;
- $u = &P4CGI::ahref(-url => "userView.cgi",
- "USER=$u",
- $fullUser) ;
- }
- else {
- $u = "<b>Old user:</b> $u"
- }
- my $bgcol = "" ;
- if($n>0) {
- $bgcol="background-color: blue ;" ;
- } ;
- &P4CGI::start_table("colums=\"3\" style=\"width: 100%; border-collapse: collapse;\""),
- &P4CGI::table_row({-text => "$u",
- -style => "width: $NAME_WIDTH; text-align: left ; ",
- -align => "right"},
- {-text => $n==0?"-":"$n",
- -style => "width: $CNT_WIDTH; text-align: center ;"},
- "<table style=\"border-collapse: collapse ; width: 100% ;\">\n".
- " <tr><td style=\"width: $w\% ; height: 1em; $bgcol\"></td><td></td></tr>\n".
- "</table>\n") ;
- print &P4CGI::end_table() ;
- }
- print &P4CGI::end_framedTable() ;
- print &P4CGI::end_page() ;
- #
- # That's all folks
- #
# | Change | User | Description | Committed | |
---|---|---|---|---|---|
#8 | 4998 | Fredric Fredricson | P4DB: cleaned up some code. Added p4users(), p4client() and p4user2name() to P4CGI.pm and... modified all cgi:s to use these, « |
20 years ago | |
#7 | 4990 | Fredric Fredricson | P4DB: Improved error handling: | 20 years ago | |
#6 | 4871 | Fredric Fredricson | P4DB: Updates to depot statistics page and two minor style sheet pdates | 20 years ago | |
#5 | 4835 | Fredric Fredricson | P4DB: Fixed problem with depot statistics (now much better html and CSS (but not 100% yet.....) « |
20 years ago | |
#4 | 4306 | Fredric Fredricson | P4DB: Hardened P4DB against malicious parameters (cross site scripting), performed some c...leanup and increased version to 3.1.1. « |
21 years ago | |
#3 | 4237 | Fredric Fredricson | P4DB: Maybe the final submit for P4DB 3.1.0 | 21 years ago | |
#2 | 2875 | Fredric Fredricson | P4DB 3.0 first beta... | 22 years ago | |
#1 | 1638 | Fredric Fredricson | P4DB: Added all (I think) files for P4DB | 23 years ago |