| #!/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 </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 </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> </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> </td><td colspan=4 align="center"><b>by login</td> | |
| <td> </td> | |
| <td colspan=5 align="center"><b>by 3-6-9 month activity</td> | |
| </tr><tr> | |
| <td> </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> </td> | |
| <td> </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> </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> </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 ); | |
| } |