| #!/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 </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\"> </td><td bgcolor=\"$color\"> </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> </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; | |
| } |