blob: 173720a210bd662e01825d4ecd055c340e791027 [file] [log] [blame]
#!/usr/bin/perl
# Copyright (c) 2006 Eclipse Foundation, made available under EPL v1.0
# Contributors Ward Cunningham, Bjorn Freeman-Benson
use strict;
require 'siteconfig';
use Date::Parse;
print "Content-type: text/html\n\n";
my (%y, %x, %counts);
our $site;
my $site3 = "www.eclipse.org";
my $prog = "/dash/commits/web-api/commit-active-committers.php";
my $prog2 = "/dash/commits/web-api/commit-projects.php";
my $prog3 = "projects/web-api/commit-inactives.php";
my $prog4 = "projects/web-api/commit-projects-committers.php";
my $args;
#
# $data{login}{'ONE'} = number of commits in the last one months
# $data{login}{'THREE'} = number of commits in the last three months
# $data{login}{'SIX'} = number of commits in the last six months
# $data{login}{'NINE'} = number of commits in the last nine months
# $data{login}{0} = 0 this login is a committer on the project
# $data{login}{0} = 1 this login has committed something
#
my %data;
#
# $actives{'______'}{x} = date queried for x month results
# $actives{login}{x} = true if active in the last x months
#
my %actives;
#
# $inactives{login} = true if this committer is now inactive in db
#
my %inactives;
my %projects;
my %tops;
my $log;
my $projectkey;
my $showinactiveflags = 0;
my $information = "Graphs that slope up to the right indicate
increasing activity by the committer. Those
that slope down to the right indicate
decreasing activity. Bars are nine, six and three month
activity history scaled per committer.
";
my @information = split /\n/, $information;
my $var = 'top|project|company';
if( $ENV{QUERY_STRING} ) {
$_ = $ENV{QUERY_STRING};
my $var = 'top|project|company';
($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/;
($projectkey) = $args =~ /project=([^&]+)/;
$showinactiveflags = 1 if( $projectkey );
print <<;
<html><head>
<META NAME="ROBOTS" CONTENT="NOINDEX,NOFOLLOW">
<script>
bar = new Array();
for( i = 16; i >= 0; i-- ) {
bar[i] = new Image(16,15);
// bar[i].src = "one-activity.cgi?" + i;
bar[i].src = "images/15bar" + i + ".png";
}
</script>
</head><body>
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr style="background-image: url(header_bg.gif);">
<td>
<a href="http://www.eclipse.org/"><img src="header_logo.gif" width="163" height="68" border="0" alt="Eclipse Logo" class="logo" /></a>
</td>
<td align="right" style="color: white; font-family: verdana,arial,helvetica; font-size: 1.25em; font-style: italic;"><b>Eclipse dashboard&nbsp;</b></font> </td>
</tr>
</table>
query();
query2();
query3();
report();
} else {
print <<;
<html><head>
<meta name="ROBOTS" CONTENT="NOINDEX,NOFOLLOW">
</head><body>
<table width="100%" border="0" cellpadding="0" cellspacing="0">
<tr style="background-image: url(header_bg.gif);">
<td>
<a href="http://www.eclipse.org/"><img src="header_logo.gif" width="163" height="68" border="0" alt="Eclipse Logo" class="logo" /></a>
</td>
<td align="right" style="color: white; font-family: verdana,arial,helvetica; font-size: 1.25em; font-style: italic;"><b>Eclipse dashboard&nbsp;</b></font> </td>
</tr>
</table>
query1();
report1();
}
print <<;
</body></html>
sub query {
my @dates = ( 'ONE', 'THREE', 'SIX', 'NINE' );
open S1, "/usr/bin/wget -q -O- http://$site/$prog?$args|" or die $!;
my $x = 0;
my $y = 0;
while (<S1>) {
if (/^#/) {
$log .= "$_<br>";
if( $_ =~ /AS ([A-Z_]+) .*WHERE YEARMONTHDAY \>\= ([0-9][0-9][0-9][0-9])([0-9][0-9])([0-9][0-9]) / ) {
$x = $1;
$y = $2 . "-" . $3 . "-" . $4;
$x = shift @dates;
}
next;
}
if( $x ) {
my ($login, $count) = split /\t/;
$data{$login}{$x} = $count;
$actives{'______'}{$x} = $y;
} else {
$_ =~ /(\w+)/;
$data{$1}{0} = 1;
}
}
close(S1);
}
sub query2 {
open S2, "/usr/bin/wget -q -O- http://$site3/$prog3|" or die $!;
while (<S2>) {
if (/^#/) {
$log .= "$_<br>";
next;
}
chomp;
my ($login, $project) = split /\t/;
$inactives{$login} = 1 if $project eq $projectkey;
}
close(S2);
}
sub query3 {
open S3, "/usr/bin/wget -q -O- http://$site3/$prog4|" or die $!;
my $onetime = str2time( $actives{'______'}{'ONE'} );
my $threetime = str2time( $actives{'______'}{'THREE'} );
my $sixtime = str2time( $actives{'______'}{'SIX'} );
my $ninetime = str2time( $actives{'______'}{'NINE'} );
while (<S3>) {
if (/^#/) {
$log .= "$_<br>";
next;
}
chomp;
my ($project, $login, $relation, $activedate) = split /\t/;
if( $project eq $projectkey && $relation eq 'CM' ) {
$data{$login}{0} = 0;
my $thentime = str2time( $activedate );
$actives{$login}{'ONE'} = $onetime > $thentime;
$actives{$login}{'THREE'} = $threetime > $thentime;
$actives{$login}{'SIX'} = $sixtime > $thentime;
$actives{$login}{'NINE'} = $ninetime > $thentime;
}
}
close(S3);
}
sub query1 {
open S4, "/usr/bin/wget -q -O- http://$site/$prog2|" or die $!;
my $x = 0;
select(STDOUT);
while (<S4>) {
if (/^#/) {
$log .= "$_<br>";
if( $_ =~ /select distinct ([A-Z]+) / ) {
$x = $1;
}
next;
}
chomp;
my ($p) = $_;
$projects{$p} = 1 if( $x eq "PROJECT" );
$tops{$p} = 1 if( $x eq "TOPPROJECT" );
}
close(S4);
}
sub report1 {
my @projects = keys %projects;
@projects = sort( @projects );
my @tops = keys %tops;
@tops = sort( @tops );
my $cols = scalar( @tops );
my $width = int( 100 / $cols );
print <<;
<h2>choose projects for committers by activity report</h2>
<table cellpadding=2 cellspacing=1><tr>
<td align=center colspan=$cols bgcolor="#FFEEFF"><font size=+1><b><a href="?all=true">all projects</a></b></font></td></tr><tr>
my @ptrs;
print "<tr>";
for( my $x = 0; $x < $cols; $x++ ) {
my $color = "#CCFFCC";
$color = "#88FF88" if int( $x % 2 ) == 1;
print "<td width=\"$width\%\" bgcolor=$color><b><a href=\"?top=$tops[$x]\">" . $tops[$x] . "</a></b></td>";
@ptrs[$x] = 0;
my $top = $tops[$x];
for( my $y = 0; $y < scalar( @projects ); $y++ ) {
if( $projects[$y] =~ /^($top)/ ) {
$ptrs[$x] = $y;
last;
}
}
}
print "</tr>\n";
while( 1 ) {
my $match = 0;
print "<tr>";
for( my $x = 0; $x < $cols; $x++ ) {
my $top = $tops[$x];
my $project = $projects[$ptrs[$x]];
my $color = "#CCFFCC";
$color = "#88FF88" if int( $x % 2 ) == 0;
$color = "#FFFFFF" if( !($project =~ /^($top)/) );
print "<td bgcolor=$color>";
if( $project =~ /^($top)/ ) {
print "<a href=\"?project=$project\">$project</a>";
$ptrs[$x]++;
$match++;
}
print "</td>";
}
print "</tr>\n";
last if( !$match );
}
print <<;
</table>
}
sub firstcell {
my $a = shift;
my $b = shift;
if( $showinactiveflags && defined($inactives{$a}) ) {
print "<td bgcolor=\"$b\"><strike>$a</strike></td>";
} else {
if( $showinactiveflags && $data{$a}{0} == 1 ) {
print "<td bgcolor=\"$b\"><font color='red'>*</font><strike>$a</strike></td>";
} else {
print "<td bgcolor=\"$b\">$a</td>";
}
}
}
sub onecell {
my $a = shift;
my $b = shift;
my $c = shift;
if( $data{$a}{$c} || $actives{$a}{$c} ) {
print "<td bgcolor=\"$b\" align=right>". nformat($data{$a}{$c}) . "</td>";
} else {
print "<td>&nbsp;</td>";
}
}
sub cellrow {
my $a = shift;
my $b = shift;
firstcell( $a, $b);
onecell( $a, $b, 'ONE' );
onecell( $a, $b, 'THREE' );
onecell( $a, $b, 'SIX' );
onecell( $a, $b, 'NINE' );
}
sub report {
print "<h2>lines of change by committer";
$_ = $args;
while (/($var)=([A-Za-z0-9_.-]{2,})/g) {
print "<br>for $1 $2";
my $qq = $_;
my $var = $1;
$qq =~ s/$1=$2&?//;
$qq =~ s/&$//;
}
print "</h2>\n";
print <<;
<table cellpadding=2 cellspacing=1><tr>
<td>&nbsp;</td><td colspan=4 align="center"><b>by login</td>
<td>&nbsp;</td>
<td colspan=5 align="center"><b>by 3-6-9 month activity</td>
</tr><tr>
<td>&nbsp;</td><td align="center"><b>one</td><td align="center"><b>three</td><td align="center"><b>six</td><td align="center"><b>nine</td>
<td>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</td>
<td>&nbsp;</td><td align="center"><b>one</td><td align="center"><b>three</td><td align="center"><b>six</td><td align="center"><b>nine</td>
<td align="center"><b>(9-6-3)</b></td>
</tr>
my @y = sort keys %data;
my @z = sort {
my $r3 = ($data{$a}{'THREE'} > 0) <=> ($data{$b}{'THREE'} > 0);
my $r6 = ($data{$a}{'SIX'} > 0) <=> ($data{$b}{'SIX'} > 0);
my $r9 = ($data{$a}{'NINE'} > 0) <=> ($data{$b}{'NINE'} > 0);
my $in = $inactives{$a} <=> $inactives{$b};
my $nm = $a cmp $b;
($r3 == 0) ?
(($r6 == 0) ?
(($r9 == 0) ?
(($in == 0) ?
-$nm : -$in)
: $r9)
: $r6)
: $r3
} keys %data;
@z = reverse @z;
for( my $i = 0; $i < @y; $i++ ) {
my $yy = $y[$i];
my $zz = $z[$i];
my $ycolor = cellcolor($yy);
my $zcolor = cellcolor($zz);
my ($zactivity1,$zactivity2,$zactivity3) = activity($zz);
print "<tr>";
cellrow( $yy, $ycolor );
print "<td>&nbsp;</td>";
cellrow( $zz, $zcolor );
print "<td><img name=\"image${i}a\" border=0/><img name=\"image${i}b\" border=0/><img name=\"image${i}c\" border=0/></td>";
print "<td>&nbsp;&nbsp;</td><td width=200 rowspan=" . scalar(@y) . " valign=top><font color=grey>" . $information . "</font></td>" if( $i == 0 );
print "<script>\n";
print "document.images[\"image${i}a\"].src = bar[$zactivity1].src;\n";
print "document.images[\"image${i}b\"].src = bar[$zactivity2].src;\n";
print "document.images[\"image${i}c\"].src = bar[$zactivity3].src;\n";
print "</script>\n";
print "</tr>\n";
}
print <<;
</table><br><br>
<table width=500><tr><td>
<font size=-1 color=gray>
$log
<p/>
The bar graphs are scaled by
committer and thus cannot be used to compare activity
between committers.
if( $showinactiveflags ) {
print <<;
Unix accounts marked as "no longer a
committer" are <strike>struck out</strike>. Unix accounts
that have committed to the project but were never committers
are marked with <strike><font color='red'>*</font></strike>.
}
print <<;
See the <a href="http://wiki.eclipse.org/index.php/Commits_Explorer">wiki page</a> about known data anamolies.
See the <a href="$prog?$args">raw data</a> we use.
<p>This automatically collected information may not represent
true activity and should not be used as sole indicator of
individual or project behavior.
</font>
</table>
}
sub nformat {
my $v = shift;
return "" if !$v;
my $text = reverse $v;
$text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
return scalar reverse $text;
}
sub cellcolor {
my $x = shift;
return "#66FF66" if( $data{$x}{'THREE'} > 0 );
return "#99FF99" if( $data{$x}{'SIX'} > 0 );
return "#CCFFCC" if( $data{$x}{'NINE'} > 0 );
return "#FFEEEE";
}
sub activity {
my $x = shift;
my $d3 = $data{$x}{'THREE'};
my $d6 = $data{$x}{'SIX'} - $d3;
my $d9 = $data{$x}{'NINE'} - $d3 - $d6;
my $f = 1.0;
my $m = $d3;
$m = $d6 if $d6 > $m;
$m = $d9 if $d9 > $m;
$f = 15.0 / $m if( $m > 0.0) ;
my $p3 = int( $d3 * $f );
my $p6 = int( $d6 * $f );
my $p9 = int( $d9 * $f );
$p3 = 15 if $p3 > 15;
$p6 = 15 if $p6 > 15;
$p9 = 15 if $p9 > 15;
$p3 = 1 if $p3 == 0;
$p6 = 1 if $p6 == 0;
$p9 = 1 if $p9 == 0;
return ( $p9,$p6,$p3 );
}