blob: 1772a7c49f77172a7e2baac01fe50b34d6a54b69 [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;
use Sys::Hostname;
require 'siteconfig';
print "Content-type: text/html\n\n";
my (%y, %x, %counts);
our $site;
my $prog = "/dash/commits/web-api/commit-active-projects.php";
my $args;
my %data;
my %dates;
my @dates;
my %projects;
my @projects;
my $log;
my $_max;
my $_min;
my $information = "Graphs that slope up to the right indicate
increasing activity on the project. Those
that slope down to the right indicate
decreasing activity. One bar per month from the beginning
of the project until the current month.
";
my @information = split /\n/, $information;
my $var = 'top|project|company';
$_ = $ENV{QUERY_STRING};
($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/;
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>
query();
report();
sub query {
my $sockaddr = 'S n a4 x8';
my $AF_INET = 2;
my $SOCK_STREAM = 1;
chop(my $hostname = hostname());
my ($name, $aliases, $proto) = getprotobyname('tcp');
my ($name, $aliases, $type, $len, $thisaddr) = gethostbyname($hostname);
my ($name, $aliases, $type, $len, $thataddr) = gethostbyname($site);
my $this = pack($sockaddr, $AF_INET, 0, $thisaddr);
my $that = pack($sockaddr, $AF_INET, 80, $thataddr);
socket (S, $AF_INET, $SOCK_STREAM, $proto) || die "socket: $!";
bind(S, $this) || die "bind: $!";
connect(S, $that) || die "connect: $!";
select(S);
$| = 1;
print S "GET /$prog?$args\r\n";
select(STDOUT);
while (<S>) {
if (/^#/) {
$log .= "$_<br>";
next;
}
chomp;
if( $_max && $_min ) {
my ($project,$date,$count) = split /\t/;
$data{$project}{$date} = $count;
$dates{$date} = 1;
$projects{$project} = 1;
} else {
$_min = $_ if $_max;
$_max = $_ unless $_max;
}
}
}
sub report {
print "<h2>lines of change by projects by month";
print " <font size=-2><a href=\"active-projects-2.cgi?$args\">active committers</a></font>";
$_ = $args;
while (/($var)=([A-Za-z0-9_.-]{2,})/g) {
print "<br>for $1 $2" if( $2 ne "true" );
my $qq = $_;
my $var = $1;
$qq =~ s/$1=$2&?//;
$qq =~ s/&$//;
}
print "</h2>\n";
my $dt = $_min;
while( $dt <= $_max ) {
$dates{$dt} = 1;
if( ($dt % 100) >= 12 ) {
$dt = (int( $dt / 100 ) + 1) * 100 + 1;
} else {
$dt++;
}
}
@dates = keys %dates;
@projects = keys %projects;
@dates = sort @dates;
@projects = sort @projects;
my $color = "#AAFFAA";
print "<table cellpadding=2 cellspacing=1>\n";
# print "<tr><td bgcolor=\"$color\">&nbsp;</td><td bgcolor=\"$color\">&nbsp;</td>";
# foreach my $date ( @dates ) {
# print "<td bgcolor=\"$color\">$date</td>";
# }
print "</tr>\n";
my $key = "project";
$key = "top" if( $args =~ /top=true/ );
my $first = 1;
foreach my $project ( @projects ) {
compute_activity( $project );
print "<tr><td bgcolor=\"$color\"><a href=\"summary.cgi?company=y&month=x&$key=$project\">$project</a></td>";
print "<td bgcolor=\"$color\" align=right><img src=\"line-activity.cgi?" .
$data{$project}{LINEDATA} . "\"/></td>";
print "<td>&nbsp;&nbsp;</td><td width=200 rowspan=" . scalar(@projects) . " valign=top><font color=grey>" . $information . "</font></td>" if $first;
$first = 0;
# foreach my $date ( @dates ) {
# print "<td bgcolor=\"$color\" align=right>" . nformat($data{$project}{$date}) . "</td>";
# }
print "</tr>\n";
}
# my $ycolor = cellcolor($yy);
print <<;
</table><br><br>
<table width=500><tr><td>
<font size=-1 color=gray>
$log
<p/>
<p>The sparklines are scaled by
project and thus cannot be used to compare activity
between projects.
See the <a href="http://wiki.eclipse.org/index.php/Commits_Explorer">wiki page</a> about known data anamolies.
See <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 compute_activity {
my $project = shift;
my @ys;
# get the data array
my $seenany = 0;
foreach my $date ( @dates ) {
if( $seenany || defined( $data{$project}{$date} ) ) {
my $d = $data{$project}{$date};
$d = 0 unless $d;
push @ys, $d;
$seenany = 1;
}
}
my @xs = @ys;
# scale data so that maximum is max bar height
my @zs = scale( \@ys, 20.0 );
# scale data so that median is mid-point bar height
my $clip = max( \@ys );
for( my $idx = 0; $idx < 4; $idx++ ) {
my $avg = average( \@zs, \@xs );
last if( $avg >= 7.0 && $avg <= 13.0 );
$clip *= $avg / 10.0;
@ys = clip( \@xs, $clip );
@zs = scale( \@ys, 21.0 );
}
# ensure that non-zero values are different than zeros
@zs = nonzero( \@zs, \@xs );
$data{$project}{LINEDATA} = join( ",", @zs );
}
sub scale {
my $ins = shift;
my $maxout = shift;
my @outs;
my $maxin = 0;
foreach my $v ( @$ins ) {
$maxin = $v if $v > $maxin;
}
return @$ins unless $maxin;
my $scale = $maxout / $maxin;
foreach my $v ( @$ins ) {
my $d = int( $v * $scale );
push @outs, $d;
}
return @outs;
}
sub clip {
my $ins = shift;
my $max = shift;
my @outs;
foreach my $v ( @$ins ) {
my $d = $v;
$d = $max if $d > $max;
push @outs, $d;
}
return @outs;
}
sub max {
my $ins = shift;
my $max = 0;
foreach my $v ( @$ins ) {
$max = $v if $v > $max;
}
return $max;
}
sub average {
my $ins = shift;
my $orig = shift;
my $sum = 0;
my $cnt = 0;
for( my $i = 0; $i < @$ins; $i++ ) {
my $v = $ins->[$i];
my $v0 = $orig->[$i];
if( $v0 ) {
$sum += $v;
$cnt++;
}
}
return 0 unless $cnt;
return $sum / $cnt;
}
sub nonzero {
my $ins = shift;
my $orig = shift;
my @outs;
for( my $i - 0; $i < @$ins; $i++ ) {
my $v = $ins->[$i];
my $v0 = $orig->[$i];
$v = 2 if $v0 && !$v;
$v = 1 if !$v0;
push @outs, $v;
}
return @outs;
}