#!/usr/bin/perl -w
# -*- perl -*-
#################################################################
#
#
# The great
#
# P 4 S U B M I T R A C E
#
# contest
#
#
#
# This is unpublished and unofficial and unsupported and untrusted
# and unbelivable non-proprietary source code of MYDATA automation AB
# Do whatever You want with it. We don't care.
#
# Send Your comments, flames, fan email, threats, email bombs, spam etc to:
# fredric@mydata.se
# Please check out our boring web site: http://www.mydata.se
#
#
# Read configuration file:
#
my $configFile="config" ;
unless( -r $configFile) {
$configFile="config.org" ;
} ;
eval `cat $configFile` ;
#
my $DEFAULT_LENGTH = 499 ; # Set default number of changes
#
# Troubleshooting guide:
# Apart from the usual problems with cgi's You might get in touble
# with the P4 protection system. I think You must have at least "list"
# access to the depot, but I have not tested this so.....
#
# Other than that: You're on You own.
#
#################################################################
my %subsByUsr;
# Contains number of submits by user
my %userpoints;
# Contains "points" per user (actually, used to compute the
# "mean position" of all the submits found by user). This is used to
# evaluate users "speed".
my %ptsInLast10;
# Contains number of submits in the last ten percent. A little "extra"
# feature to make comments more interesting.
#
# 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 ";
my $blink="B" ;
if(($browser =~ /mozilla/i) and not ($browser =~ /msie/i)) {
$bestViewed = "Microsoft Explorer " ;
$blink="BLINK" ;
}
#
# Read p4 repository
#
my $heading = "P4 submit race
\n" ;
my $title = "P4 submit race" ;
my $changes = $ARGV[0] ;
unless($changes) {
$changes = $DEFAULT_LENGTH ;
} ;
open CHANGES, "$P4 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 () {
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 users|") ;
while() {
/^(\w+).*\(([^\)]+)\)/ || 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",
$year %1000,$mon+1,$mday,
$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() {
/#####/ && 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 loosing" 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 of users submits that 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 big trouble" if ($troublePts > 20);
$tmp = "$and in huge 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="<$blink>First$blink>" ;
};
$pos eq "2" && do {
$pos="Second";
};
$pos eq "3" && do {
$pos="Third" ;
};
#
# End first table and start second if position is greater than 3
#
$posInRace ge "4" && ($table eq "first") && do {
while() {
/#####/ && 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 = " Next to dec." if $usr eq $lastUsr;
print "$pos | $user | $subsByUsr{$usr}$last | $status |
\n";
};
#
# Print trailer
#
while() {
print ;
}
#
__END__
Content-type: text/html
TITLE_HERE
HEADING_HERE
DATE_HERE
This page is best viewed with BW_HERE
Position | User | # of submits | Comment |
#####
Followed by:
Position | User | # of submits | Comment |
#####
Comments to fredric@mydata.se