commits/web-app/summary.cgi

#!/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';

our $site;
print "Content-type: text/html\n\n";
my (%y, %x, %counts);
my $prog = "/dash/commits/web-api/commit-summary.php";

# id date yearmonth project repository filename type revision change login message
# project date login type change message

$_ = $ENV{QUERY_STRING} || 'top=y&year=x';
my $var = 'year|month|day|top|project|company|login|type|change|message';
my $num = 'change|message';
my ($x) = /($var)=x/;
my ($y) = /($var)=y/;
my ($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/;
my $log;


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>


print "<h2>commits by $y by $x";
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 " <a href=summary.cgi?$qq><font size=-2>all ${var}s</font></a>";
}
print "</h2>";

#print "$q<br>\n";

query();
report();

sub query {
    
    my $sockaddr = 'S n a4 x8';
    my $AF_INET = 2;
    my $SOCK_STREAM = 1;
    chomp(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;
        }
        my ($x, $y, $count) = split /\t/;
        #print "$x $y $count<br>\n";
        $y{$y}++;
        $x{$x}++;
        $counts{$y}{$x} = $count;
    }
}

sub report {
    
    my %succ = (
        'top' => 'project',
        'project' => 'company',
        'company' => 'login',
        'login' => 'type',
        'year' => 'month',
        'month' => 'day'
    );
    
    print <<;
        <table cellpadding=5 cellspacing=1><tr><td>

    my @x = sort keys %x;
    @x = sort {$a <=> $b} @x if $x =~ /$num/;
    my $xx = $succ{$x};
    my $qq = "href=summary.cgi?$args" if $xx;
    $qq =~ s/$x=x/$xx=x/;
    for my $xx (@x) {
        $_ = $xx;
        s/^\d\d\d\d\d\d(\d\d)$/$1/ if $args =~ /month=\d\d/;
        s/^\d\d\d\d(\d\d)$/$1/ if $args =~ /year=\d\d/;
        s/^\d\d(\d\d)(\d\d)$/$2\/$1/;
        s/^\d\d(\d\d)(\d\d)(\d\d)$/$2\/$3\/$1/;
        print "<td align=center><font size=-1><a $qq&$x=$xx>$_</a></font>";
    }
    
    my $yy = $succ{$y};
    my $qq = "href=summary.cgi?$args" if $yy;
    $qq =~ s/$y=y/$yy=y/;
    my @y = sort keys %y;
    @y = sort {$a <=> $b} @y if $y =~ /$num/;
    for my $yy (@y) {
        $_ = $yy;
        s/^\s*$/&nbsp;/;
        print "<tr><td><a $qq&$y=$yy>$_</a>";
        for my $xx (@x) {
            my $color = ($x-1)%100/3%2 ? '#88ff88': 'bbffbb';  
            my $count = $counts{$yy}{$xx};
            print "<td align=center bgcolor=$color>$count";
        }
        print "\n";
    }
    
    print <<;
        </table><br><br>
        <table width=500><tr><td>
        <font size=-1 color=gray>
        $log
        <p/>This automatically collected information may not represent
        true activity and should not be used as sole indicator of
        individual or project behavior.
	See the <a href="http://wiki.eclipse.org/index.php/Commits_Explorer">wiki page</a> about known data anamolies.
        See <a href=details.cgi?$args>details</a> for all items in the table.
        See <a href="$prog?$args">raw data</a> we use. 
        </font>
        </table>

}