#!/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 "
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. 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=
";
open(FILE,"lastruntime.txt");
my $lastruntime=
The last run finished at ", $lastruntime, ". Right now it's ", ctime(), ".";
print "
";
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();
";
foreach $project (@newprojects) {
my $jobLink=$project->getTitle();
if (-e $project->getRptFile()) {
$jobLink="getRptURL]}\">@{[$project->getTitle()]}";
}
$result="${result}Project Home page NCSS Problems Percentage Unused Code ";
}
$result = "${result}${jobLink} @{[$project->getHomePage()]} ";
$result="${result}@{[$project->getNCSS()]} ";
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}@{[$project->getLines()]} $rounded