| #!/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-project-diversity.php"; | |
| my $args; | |
| my $type; | |
| my %data; | |
| my $log; | |
| my %years; | |
| my %companies; | |
| my $var = 'all|top|project|company|type'; | |
| $_ = $ENV{QUERY_STRING}; | |
| ($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/; | |
| ($type) = /type=([a-z]+)/; | |
| $type = 'loc' unless $type; | |
| $prog = "/dash/commits/web-api/commit-project-diversity.php" if $type eq 'loc'; | |
| $prog = "/dash/commits/web-api/commit-project-diversity-2.php" if $type eq 'active'; | |
| $prog = "/dash/commits/web-api/commit-project-diversity-3.cgi" if $type eq 'registered'; | |
| 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, $type2, $len, $thisaddr) = gethostbyname($hostname); | |
| my ($name, $aliases, $type2, $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; | |
| my ($company,$project,$year,$count) = split /\t/; | |
| ($project,$year,$count) = ("(all)",$project,$year) if( $args =~ /all=true/ && $type ne 'registered'); | |
| $data{$project}{$company}{$year} = $count; | |
| $years{$year} = 1; | |
| while( 1 ) { | |
| my $r = int( rand( 255 ) ); | |
| my $g = int( rand( 255 ) ); | |
| my $b = int( rand( 255 ) ); | |
| $companies{$company}{RED} = $r; | |
| $companies{$company}{GREEN} = $g; | |
| $companies{$company}{BLUE} = $b; | |
| last if( (($r + $g + $b) > 240) | |
| && (($r + $g + $b) < 600) | |
| ); | |
| } | |
| } | |
| } | |
| sub report { | |
| print "<h2>"; | |
| print "percent of lines of change" if $type eq 'loc'; | |
| print "percent of active committers" if $type eq 'active'; | |
| print "percent of registered committers" if $type eq 'registered'; | |
| print " by " . (($args =~ /top=true/) ? "top" : "project") unless ($args =~ /all=true/); | |
| print " by company by year"; | |
| my $argsmt = $args; | |
| $argsmt =~ s/&?type=([a-z]+)//; | |
| my $amp = $argsmt ? '&' : ''; | |
| print "<br>"; | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt${amp}type=loc\">lines of change</a></font>" unless $type eq 'loc'; | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt${amp}type=active\">active committers</a></font>" unless $type eq 'active'; | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt${amp}type=registered\">registered committers</a></font>" unless $type eq 'registered'; | |
| if( !($type eq 'registered') ) { | |
| $argsmt = $args; | |
| $argsmt =~ s/&?top=true//; | |
| $argsmt =~ s/&?all=true//; | |
| $amp = $argsmt ? '&' : ''; | |
| print " "; | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt\">project</a></font>" if ($args =~ /top=true/ || $args =~ /all=true/); | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt${amp}top=true\">top</a></font>" unless ($args =~ /top=true/); | |
| print " <font size=-2><a href=\"project-diversity.cgi?$argsmt${amp}all=true\">all</a></font>" unless ($args =~ /all=true/); | |
| } | |
| $_ = $args; | |
| while (/($var)=([A-Za-z0-9_.-]{2,})/g) { | |
| print "<br>for $1 $2" if( $2 ne "true" && $1 ne 'type' ); | |
| my $qq = $_; | |
| my $var = $1; | |
| $qq =~ s/$1=$2&?//; | |
| $qq =~ s/&$//; | |
| } | |
| print "</h2>\n"; | |
| my @projects = keys %data; | |
| @projects = sort @projects; | |
| my @years = keys %years; | |
| @years = sort @years; | |
| my $color = "#CCFFCC"; | |
| print "<table cellpadding=2 cellspacing=1>\n"; | |
| my $key = "project"; | |
| $key = "top" if( $args =~ /top=true/ ); | |
| print "<tr><td> </td><td align=center>" . $years[scalar(@years)-1] . "</td><td> </td>"; | |
| foreach my $year ( @years ) { | |
| print "<td align=center>$year</td>"; | |
| } | |
| print "</tr>\n"; | |
| foreach my $project ( @projects ) { | |
| my %subdata = %{$data{$project}}; | |
| my @companies = keys %subdata; | |
| @companies = sort @companies; | |
| my %sum; | |
| my %percent; | |
| foreach my $year ( @years ) { | |
| my $sum = 0; | |
| foreach my $company ( @companies ) { | |
| $sum += $subdata{$company}{$year}; | |
| } | |
| $sum = 1 if $sum < 1; | |
| $sum{$year} = $sum; | |
| foreach my $company ( @companies ) { | |
| my $percent = $subdata{$company}{$year} / $sum{$year}; | |
| $percent = int( $percent * 100 ); | |
| $percent = 1 if( !$percent && $subdata{$company}{$year} ); | |
| $percent{$company}{$year} = $percent; | |
| } | |
| } | |
| my @yearNpercents; | |
| my @finalcolors; | |
| foreach my $company ( @companies ) { | |
| push @yearNpercents, $percent{$company}{$years[scalar(@years)-1]}; | |
| push @finalcolors, $companies{$company}{RED}; | |
| push @finalcolors, $companies{$company}{GREEN}; | |
| push @finalcolors, $companies{$company}{BLUE}; | |
| } | |
| print "<tr><td rowspan=" . scalar( @companies ) . " bgcolor=\"$color\"><a href=\"summary.cgi?company=y&month=x&$key=$project\">$project</a></td>"; | |
| print "<td bgcolor=$color rowspan=" . scalar( @companies ) | |
| . "><img src=\"pie-chart.cgi?" | |
| . join(",", @yearNpercents) . ";" . join(",", @finalcolors) . "\"/></td>"; | |
| foreach my $company ( @companies ) { | |
| print "<tr>" unless $company eq $companies[0]; | |
| print "<td bgcolor=$color><a href=\"summary.cgi?login=y&month=x&$key=$project&company=$company\">$company</a></td>"; | |
| foreach my $year ( @years ) { | |
| my $percent = $percent{$company}{$year}; | |
| print "<td bgcolor=$color align=right>" . $percent . "\%</td>" if $percent; | |
| print "<td bgcolor=$color> </td>" unless $percent; | |
| } | |
| } | |
| if( $color eq "#CCFFCC" ) { $color = "#88FF88"; } else { $color = "#CCFFCC"; } | |
| } | |
| 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="$prog?$args">raw data</a> we use. | |
| </font> | |
| </table> | |
| } | |