p4race.cgi #1

#!/usr/local/bin/perl5
# -*- perl -*-
#####################################################################
##
##  CONFIGURATION INFORMATION 
##  All config info should be in $configFile (see init() in P4CGI.pm)
##
#####################################################################
#
#                         The Great
#                  P 4   S U B M I T   R A C E
#
#####################################################################
#
# Read configuration file
my $configFile="CONFIG" ;
eval `cat $configFile` ;

# Set default number of changes
my $DEFAULT_LENGTH = 499 ;

### Set user's P4 port
# Load IPaddr/host:port pairs into lookup table
my $ipaddr = $ENV{REMOTE_ADDR} ;
my %p4ports ;
my ($key,$val,$addr,$port) ;
my @cookies = split( /; /, $ENV{HTTP_COOKIE} ) ;
foreach( @cookies ) {
  ($key, $val) = split( /=/, $_ ) ;
  if( $key eq "USERS_P4PORT" ) {
    ($addr,$port) = split( /-/, $val ) ;
    $p4ports{$addr} = $port ;
  } 
}
# See if they have a cookie; if they do, set their P4PORT to it
if( defined $p4ports{$ipaddr} ) {
  $userP4PORT = $p4ports{$ipaddr} ;
}
# ...else, give them the default
else {
  $userP4PORT = $ENV{P4PORT} ;
}

# Set p4 command path
my $P4="./p4" ;


#####################################################################
# Troubleshooting guide:
# Apart from the usual problems with cgi's, you might get into trouble
# with the P4 protection system. I think you must have at least list
# access to the depot, but I have not tested this so...
#
#####################################################################

# Number of submits by user
my %subsByUsr;

# "Points" per user (actually, used to compute the "mean position" of
# all the submits by user that were found). This is used to evaluate
# the user's "speed".
my %userpoints;

# Number of submits in the last ten percent. A little "extra" feature,
# to make comments more interesting.
my %ptsInLast10;

# Find out if mozilla (a plot to make the user feel he is always wrong)
my $browser = $ENV{"HTTP_USER_AGENT"} ;
my $bestViewed = "Netscape Navigator <!-- not $browser -->";
my $blink="B" ;
if(($browser =~ /mozilla/i) and not ($browser =~ /msie/i)) {
    $bestViewed = "Microsoft Explorer <!-- not $browser -->" ;
    $blink="BLINK" ;
}

#  Read p4 repository
my $heading = "<BIG><FONT COLOR=blue>P4 submit race</FONT></BIG><BR>\n" ;
my $title = "P4 submit race" ;
my $changes = $ARGV[0] ;
unless($changes) {
    $changes = $DEFAULT_LENGTH ;
} ;
# Set default number of changes
my $DEFAULT_LENGTH = 499 ;

open CHANGES, "$P4 -p $userP4PORT changes -m $changes -s submitted|" ;
$title="$title the last $changes changes" ;
$heading="$heading the last $changes changes" ;
my $tenPercent = $changes/10 ;
my $pos = 0 ;
my $lastUsr ;
my $leadChange ;
while (<CHANGES>) {
    unless(defined $lastChange) {
	/^Change (\d+).*/ ;
	$leadChange = $1 ;
    };
    $changes-- || do { last ; } ;
    /(\w+)@/ || do { next ; } ;
    $pos++ ;
    $lastUsr = $1 ;
    if(!$subsByUsr{$1}) { 
	$subsByUsr{$1} = 1 ; 
	$userpoints{$1} = $pos ;
    } 
    else {
	$userpoints{$1} += $pos ;
	$subsByUsr{$1}++ ;
    }
    if($changes < $tenPercent) {
	if(defined $ptsInLast10{$1}) { $ptsInLast10{$1} += 1 ; } 
	else                         { $ptsInLast10{$1} = 1 ; } ;
    }
}
my $total = $pos ;
close CHANGES;

my %userToName ;
open(F,"$P4 -p $userP4PORT} users|")  ;
while(<F>) {    
    /^(\w+).*>\s+\((.*)\)\s+acc/ || do { next ; } ;    
    $userToName{$1}=$2 ;
};
close(F) ;

### Write HTML code
# Get date and time
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) =
    localtime(time());
my $date = sprintf("%2.2d/%2.2d/%2.2d %2.2d:%2.2d",
		   $mon+1,$mday,$year %1000,
		   $hour,$min) ;
# Compute a background color
srand($leadChange) ;
my $bc=(((((rand(0x10)*5)+0xB0) & 0xf0)*0x10000)+
	((((rand(0x10)*5)+0xB0) & 0xf0)*0x100)  +
	(( (rand(0x10)*5)+0xB0) & 0xf0)) ;
my $lcolor=sprintf("%6.6X",$bc & 0xf0f0f0) ;

# Read first part of HTML
while(<DATA>) {
    /#####/ && do { last ; } ;
    s/BW_HERE/$bestViewed/g ;
    s/TITLE_HERE/$title/g ;
    s/HEADING_HERE/$heading/g ;
    s/DATE_HERE/$date/g ;
    s/BGCOLOR_HERE/$lcolor/g ;
    s/SET_HERE/$set/g ;
    print ;
}

# Start building table
my $posInRace = 0;
my $prevUserPoints = 0;
my $usersAtSamePos = 1;
my $usr ;
my $pos ;
my $table="first" ;
foreach $usr (sort { $subsByUsr{$b} <=> $subsByUsr{$a} } (keys %subsByUsr)){

    # Compute weighted mean position for users submits
    my $meanPos = 100*(1-($userpoints{$usr}/($subsByUsr{$usr}*$total))) ;
    
    # Set a status message depending on mean pos
    my $status ;
    $status = "A LOSER" ;
    $status = "Losing position fast"  if $meanPos > 10 ;
    $status = "Losing"                if $meanPos > 25 ;
    $status = "Slowly losing"         if $meanPos > 33 ;
    $status = "Almost keeping pace"   if $meanPos > 43 ;
    $status = "Hanging in there"      if $meanPos > 47 ;
    $status = "Almost advancing"      if $meanPos > 53 ;
    $status = "Slowly advancing"      if $meanPos > 57 ;
    $status = "Advancing"             if $meanPos > 70 ;
    $status = "Advancing fast"        if $meanPos > 80 ;
    $status = "A ROCKET!"             if $meanPos > 90 ;

    # Compute how many users submits are in the last 10%
    # (== he will soon lose the points)
    my $troublePts = 0 ;
    # Contains percentage of points in last 10% of submits
    if(defined $ptsInLast10{$usr}) { 
	$troublePts = ($ptsInLast10{$usr}*100)/$subsByUsr{$usr} ; 
    } ;

    # Add an extra text if user has a lot of points in last 10%
    my $and = " and" ;
    $and = " but" if $meanPos > 43 ;
    my $tmp = "" ;
    $tmp = "$and in some trouble"                   if ($troublePts > 12) ;
    $tmp = "$and in trouble"                        if ($troublePts > 15);
    $tmp = "$and in <B>big</B> trouble"             if ($troublePts > 20);
    $tmp = "$and in <B><BIG>huge</BIG></B> trouble" if ($troublePts > 30);
    $status .=$tmp ;

    if($subsByUsr{$usr} != $prevUserPoints){
	$posInRace      = $posInRace + $usersAtSamePos;
	$prevUserPoints = $subsByUsr{$usr};
	$usersAtSamePos = 1;
	$pos            = $posInRace ;
    } else { 
	$usersAtSamePos = $usersAtSamePos + 1;
	$pos =" " ;
    } ;
    
    # Treat the first three special
    $pos eq "1" && do { 
	$pos="<BIG><FONT COLOR=red><$blink>First</$blink></FONT></BIG>"   ;
    };
    $pos eq "2" && do { 
	$pos="<BIG><FONT COLOR=blue>Second</FONT></BIG>";
    };
    $pos eq "3" && do { 
	$pos="<BIG><FONT COLOR=blue>Third</FONT></BIG>"  ;
    };

    # End first table and start second if position is greater than 3
    $posInRace ge "4" && ($table eq "first") && do {
	while(<DATA>) {
	    /#####/ && do { last ; } ;
	    print ;
	}
	$table="second" ;
    } ;
    
    # Translate user to "real name", if available
    my $user = $usr ;
    if($userToName{$usr} && ($userToName{$usr} ne $usr)) {
	$user = "$userToName{$usr}" ;
    };
    
    # Print table entry
    my $last="" ;
    $last = " <FONT COLOR=red><SMALL>Next to dec.</SMALL></FONT>" if $usr eq $lastUsr;
    print "<TR><TD ALIGN=CENTER><B>$pos</B></TD><TD>$user</TD><TD ALIGN=CENTER>$subsByUsr{$usr}$last</TD><TD>$status</TD></TR>\n";    
};

# Print trailer
while(<DATA>) {
    print ;
}

#
__END__
Content-type: text/html

<HTML>
<TITLE> TITLE_HERE </TITLE>
<META HTTP-EQUIV="REFRESH" CONTENT="60">
<BODY BGCOLOR="#BGCOLOR_HERE"> 
<H1 ALIGN=CENTER> HEADING_HERE </H1>
<CENTER><BIG><B><I>DATE_HERE</I></B></BIG></CENTER>
<BR>
<HR>
<TABLE BORDER=10 ALIGN=CENTER BGCOLOR=white>
<TR><TH>Position</TH><TH>User</TH><TH># of submits</TH><TH>Comment</TH></TR>
#####
</TABLE>
<BIG>Followed by:</BIG>
<TABLE BORDER=3 BGCOLOR="#E0E0E0">
<TR><TH>Position</TH><TH>User</TH><TH># of submits</TH><TH>Comment</TH></TR>
#####
</TABLE>
<HR>
</BODY>
</HTML>