| #!/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 </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*$/ /; |
| 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> |
| |
| } |
