| #!/usr/bin/perl |
| # Copyright (c) 2006 Eclipse Foundation, made available under EPL v1.0 |
| # Contributors Ward Cunningham, Bjorn Freeman-Benson |
| |
| |
| use strict; |
| |
| print "Content-type: text/html\n\n"; |
| |
| my ($project)=$ENV{QUERY_STRING} =~ /project=([a-z0-9.]+)/; |
| $project = 'technology.dash' unless $project; |
| my ($count) = $ENV{QUERY_STRING} =~ /count=(\d+)/; |
| $count = 200 unless $count; |
| my ($days) = $ENV{QUERY_STRING} =~ /days=(\d+)/; |
| $count = 100 unless $count; |
| |
| my %words; |
| my %breakdown; |
| |
| my $lastmonth; |
| |
| print "<table cellpadding=10><tr><td valign=top>"; |
| projects(); |
| print "<td valign=top>"; |
| tags(); |
| print "</table>\n"; |
| |
| sub trouble { |
| print "Trouble: $_[0]\n"; |
| die $_[0]; |
| } |
| sub head { |
| my ($title) = @_; |
| print <<; |
| <table width=100%><tr><td bgcolor=#88ff88 align=center> |
| <font color=white size=+2> |
| $title |
| </font> |
| </table> |
| |
| } |
| sub tags { |
| my %months; |
| |
| open (F, "uniq/$project") or trouble ("$project: $!"); |
| while ($_ = <F>) { |
| s/(\d\d\d\d\d\d)\d\d//; |
| my $mo = $1; |
| $months{$mo}++; |
| my @words = /(\w+)/g; |
| for (@words) { |
| $words{$_}++; |
| $breakdown{$mo}{$_}++; |
| } |
| } |
| |
| my @words = keys %words; |
| my $words = @words; |
| my $frequent = $words < $count ? $words : $count; |
| my @frequent = (sort {$words{$b} <=> $words{$a}} @words)[0..($frequent-1)]; |
| my ($max, $min) = ($words{$frequent[0]}, $words{$frequent[$#frequent]}); |
| |
| head ("Lifetime"); |
| for (sort @frequent) { |
| my $n = $words{$_}; |
| my $ratio = ($n+1 - $min) / ($max - $min); |
| my $size = int(log($ratio)+7); |
| print "<font size=$size>$_</font>\n"; |
| } |
| |
| my @months = keys %months; |
| my $months = @months; |
| |
| for my $m (sort @months) { |
| my %mwords = %{$breakdown{$m}}; |
| my @mwords = keys %mwords; |
| my $mwords = @mwords; |
| for (@mwords) { |
| $mwords{$_} = $mwords{$_}*$months - $words{$_}; |
| } |
| my $frequent = $mwords < $count ? $mwords : $count; |
| my @frequent = (sort {$mwords{$b} <=> $mwords{$a}} @mwords)[0..$frequent-1]; |
| my ($max, $min) = ($mwords{$frequent[0]}, $mwords{$frequent[$#frequent]}); |
| |
| my @mon = qw(Nil Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); |
| $m =~ /(....)(..)/; |
| head("$mon[$2] $1"); |
| |
| for (sort @frequent) { |
| my $n = $mwords{$_}; |
| my $ratio = ($n - $min + 1) / ($max - $min + 1); |
| my $size = int(log($ratio)+7); |
| print "<font size=$size>$_</font>\n"; |
| } |
| } |
| |
| print <<; |
| <br><br><table width=400><tr><td><font color=gray size=-1> |
| These $frequent words are the most frequent of |
| $words words found on $. commit |
| messages recorded over $months months by the |
| $project project. |
| See <a href="uniq/$project">raw data</a> used by this script. |
| </font></table> |
| |
| } |
| |
| sub projects { |
| opendir (D, 'uniq'); |
| my @projects = (grep !/^\./, readdir(D)); |
| for (@projects) { |
| my $size = "size=+2" if $_ eq $project; |
| print "<font $size><a href=http:tags.cgi?project=$_&count=$count>$_</a></font><br>\n"; |
| } |
| } |
| |