| #!/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"; |
| our $site; |
| my $prog = "//dash/commits/web-api/commit-details.php"; |
| |
| # id date yearmonth project repository filename type revision change login message |
| # project date login type change message |
| |
| $_ = $ENV{QUERY_STRING} || 'top=technology&project=technology.dash&year=2006&month=200602&company=individual&login=wcunningh'; |
| |
| #my $fields = 'id|time|year|month|day|top|project|cvsroot|file|type|version|change|message|login'; |
| my $fields = 'id|time|year|month|day|top|project|file|type|version|change|message|login|company'; |
| my $var = 'year|month|day|top|project|company|login|type|change|message'; |
| my $num = 'change|message'; |
| my ($args) = /((($var)=[A-Za-z0-9_.-]+&?)+)/; |
| my $log; |
| |
| my %cvs = ( |
| '/cvsroot/webtools' => 'WebTools', |
| '/cvsroot/technology' => 'Technology', |
| '/cvsroot/birt' => 'BIRT', |
| '/cvsroot/eclipse' => 'Eclipse', |
| '/cvsroot/tptp' => 'TPTP', |
| '/cvsroot/tools' => 'Tools' |
| ); |
| |
| |
| 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>commit details"; |
| 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=details.cgi?$qq><font size=-2>all ${var}s</font></a>"; |
| $fields =~ s/$var//; |
| } |
| print "</h2>"; |
| |
| $fields =~ s/id|year|month|day|top|cvsroot|type//g; |
| my @fields = split (/\|/, $fields); |
| my @indices; |
| for (0..$#fields) { |
| push (@indices, $_) if $fields[$_]; |
| } |
| #print "$fields are ", map ("[$_] ", @indices), "<br>"; |
| |
| query(); |
| |
| 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); |
| print "<table border=0 cellspacing=0 cellpadding=3>"; |
| print "<tr>", map (" <td>$_ ", @fields[@indices]); |
| my $i; |
| while (<S>) { |
| if (/^#/) { |
| $log .= "$_<br>"; |
| next; |
| } |
| my @fields = split /\t/; |
| my $color = ($i++)/3%2 ? '#aaffaa' : 'ccffcc'; |
| $fields[7] =~ /^((\/[^\/]+){2})\/(.*\/([^\/]+))/; |
| my $cvs = $cvs{$1}; |
| $fields[7] = "<a href=\"http:\/\/dev.eclipse.org\/viewcvs\/index.cgi\/$3?rev=$fields[9]&cvsroot=\u${cvs}_Project&content-type=text\/vnd.viewcvs-markup\">$4<\/a>"; |
| print "<tr bgcolor=$color>", map ("<td> $_ ", @fields[@indices]); |
| } |
| print "</table>"; |
| } |
