#!/usr/bin/perl $| =1; use CGI qw(:standard escapeHTML); use CGI::Carp qw(fatalsToBrowser); use Time::localtime; use PMD::Project; $query = new CGI(); print $query->header(); sub nopage() { print $query->p("How'd we get here?"); } sub default() { print start_html("Run PMD on your Sourceforge project"); print "
\"Project
"; print h3("
PMD-WEB
"); print "PMD is a Java source code analysis tool - it checks your code for unused fields, empty try/catch/finally/if/while blocks, unused method parameters, and stuff like that. There's much more info here.

This table contains the results of running PMD's unused code ruleset against a bunch of Sourceforge projects. The JavaNCSS column contains the lines of code analyzed as reported by the excellent JavaNCSS utility."; print "

Comments? Questions? Please post them here.
"; open(FILE,"lastruntime.txt"); my $lastruntime=; close(FILE); print br(); print "This report is run 10 minutes past the hour at midnight, 3, 6, 9, 12, 15, 18, and 21 hours U.S. Pacific Standard Time.
The last run finished at ", $lastruntime, ". Right now it's ", ctime(), "."; print "

1/31/03: The jakarta.apache.org and xml.apache.org projects have been moved here"; print br(); print hr(); if (param("unixname")) { my $project = PMD::Project->new("Sourceforge",param("title"),param("unixname"), param("moduledirectory"), param("srcdir")); addProject($project); print p(), b("Added "), b($project->getTitle()), b(" to the schedule"), p(); } print loadProjectList(); print hr(); print "Want to run PMD on your Java Sourceforge project? Fill in the blanks and hit go:"; print start_form(); print "Project title (i.e., PMD): ", textfield(-name=>'title',-default=>'',-override=>1); print br(), "Project's Unix name (i.e., pmd): ", textfield(-name=>'unixname',-default=>'',-override=>1); print br(), "Module directory (i.e., pmd-dcpd): ", textfield(-name=>'moduledirectory',-default=>'',-override=>1); print br(), "Source directory (including module directory, i.e., pmd-dcpd/src): ", textfield(-name=>'srcdir',-default=>'',-override=>1); my $cachebuster=`date`; print $query->hidden(-name=>'cachebuster', -value=>${cachebuster}); print br(), submit(-value=>'Go'); print end_form(); print hr(); } sub loadProjectList() { my @projects = (); opendir(DIR, "jobs/") or return "can't open jobs directory!"; while (defined($file=readdir(DIR))) { if ($file =~ /txt/) { open(FILE,"jobs/${file}"); my $jobdata=; close(FILE); my $project = PMD::Project->new($jobdata); push(@projects, $project); } } @newprojects = sort { $b->getLocation() cmp $a->getLocation() || $a->getTitle() cmp $b->getTitle() } @projects; my $result=""; foreach $project (@newprojects) { my $jobLink=$project->getTitle(); if (-e $project->getRptFile()) { $jobLink="getRptURL]}\">@{[$project->getTitle()]}"; } $result="${result}"; $result="${result}"; my $ncss = $project->getNCSS(); if ($ncss == 0) { $ncss = 1; } my $rounded = (int(($project->getLines()/$ncss)*10000))/100; my $color="red"; if ($rounded < .2) { $color="#00ff00"; } elsif ($rounded < .8 ) { $color="yellow"; } $rounded = sprintf("%0.2f", $rounded); if ($project->getNCSS() == "TBD") { $rounded = "N/A"; $color = "white"; } $result="${result}"; } $result = "${result}
ProjectHome pageNCSSProblemsPercentage Unused Code
${jobLink}@{[$project->getHomePage()]}@{[$project->getNCSS()]}@{[$project->getLines()]}$rounded
"; return $result; } sub addProject() { my ($project) = @_; my $cmd = "echo \"@{[$project->getString()]}\" > @{[$project->getJobsFile()]}"; eval { # for some reason this succeeds, but the CGI script fails. Very odd. `${cmd}`; } } $page=param("state") || "default"; %states = ( 'default' => \&default ); if ($states{$page}) { $states{$page}->(); } else { nopage(); } print $query->end_html();