#!/usr/bin/perl -w
###############################################################################
# Runs krazy over the KDE source code for the EnglishBreakfastNetwork (EBN)   #
# Copyright (C) 2006-2007 by Allen Winter <winter@kde.org>                    #
#                                                                             #
# This program is free software; you can redistribute it and/or modify        #
# it under the terms of the GNU General Public License as published by        #
# the Free Software Foundation; either version 2 of the License, or           #
# (at your option) any later version.                                         #
#                                                                             #
# This program is distributed in the hope that it will be useful,             #
# but WITHOUT ANY WARRANTY; without even the implied warranty of              #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the                #
# GNU General Public License for more details.                                #
#                                                                             #
# You should have received a copy of the GNU General Public License           #
# along with this program; if not, write to the Free Software                 #
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA. #
#                                                                             #
###############################################################################
# Program options:
#   --help:          display help message and exit
#   --help:          display help message and exit
#   --version:       display version information and exit
#   --component [comp]
#                    process component 'comp'
#

use strict;
use Getopt::Long;
use Env qw (PSQL KRAZY_PLUGIN_PATH);
use Sys::Hostname;
use File::Basename;
use File::Find;
use File::Path;
use POSIX qw (strftime);

my($Prog) = 'krazyebn';
my
$VERSION = '1.2'; #split line so MakeMaker can find the version here

my(@modules); # list of modules to process.  change as desired.
my($comp);    # default component to process
my($destdir); # fullpath to the top level output directory
my($trunk);   # fullpath to the top level of the trunk checkout
my($krazy);   # fullpath to the krazy program
my($plgpth);  # fullpath to the krazy plugins
my($PSQL);    # fullpath to the psql program
my($md5);     # fullpath to the md5sum checksum program
my($svn);     # fullpath to the svnlook program

if (hostname() =~ m/englishbreakfast/) {
  $destdir = '/usr/local/www/data-ebn/krazy/reports';
  $comp = 'kde-4.0';
  $trunk = '/usr/local/src';
  $krazy = '/usr/local/www/data-ebn/krazy/bin/krazy';
  $plgpth = '/usr/local/www/data-ebn/krazy/libexec/krazy-plugins';
  $PSQL = '/usr/local/bin/psql' if (! $PSQL);
  $md5 = '/sbin/md5';
  $svn = '/usr/local/bin/svnlook';
} else {
# my system settings for testing
  $destdir = '/home/winterz/local/src/krazy';
  $comp = 'KDE';
  $trunk = '/data/kde/trunk';
  $krazy = '/usr/local/Krazy/bin/krazy';
  $plgpth = '/usr/local/Krazy/libexec/krazy-plugins';
  $PSQL = 'debug';
  $md5 = '/usr/bin/md5sum';
  $svn = 'echo';
}
#END OF SETTINGS

my($help) = '';
my($version) = '';

exit 1
if(!GetOptions('help' => \$help, 'version' => \$version,
	       'component=s' => \$comp));

&Help() if ($help);
&Version() if ($version);

# Setup for db
my($compId)=&execSql("\"SELECT id FROM components WHERE name='$comp';\"");
die "Cannot get Component Id for $comp\n" if (! $compId || $compId eq "0");

my($toolId)=&execSql("\"SELECT id FROM tools WHERE name='krazy' AND component=$compId;\"");
die "Cannot get Tool Id for krazy and component $comp\n" if (! $toolId || $toolId eq "0");

my($generation)=&execSql("\"SELECT * FROM nextval('generation');\"");

my($svnRev)=`$svn youngest $trunk/svn`;
chomp($svnRev);
$svnRev = 0 if (! $svnRev || $svnRev eq "0");

# Global settings
my(@gIgModsList);           #modules to ignore
my(@gIgSubsList)=(          #subdirs to ignore in all modules
		  "doc",
		  "cmake",
		  "pics",
		  "applnk",
		  "admin"
		 );
my($defRegex)="/////";
my($gSkipRegex)="$defRegex"; #regex of stuff to skip in a subdir
my(@gCheckList);             #plugins to run. default is all
my(@gExcludeList);           #plugins to exclude. default is none

# Per Module settings
my(@mIgSubsList);
my($mSkipRegex)="";
my(@mCheckList);
my(@mExcludeList);

# Per Subdir settings
my($sSkipRegex)="";
my(@sCheckList);
my(@sExcludeList);

# Override Global settings from the component .krazy file
&overrideSettings("$trunk/$comp");

# Create the module list
my($m);
if ($#modules < 0) {
  my ($im,$found);
  opendir(DIR,"$trunk/$comp") or die "cannot open $trunk/$comp: $!";
  while (defined($m = readdir(DIR))) {
    next unless (-d "$trunk/$comp/$m");
    next if (-l "$trunk/$comp/$m"); #skip symlinks
    next if ($m eq ".");            #skip cwd
    next if ($m eq "..");           #skip parent dir
    next if ($m eq ".svn");         #skip .svn
    $found=0;
    for $im (@gIgModsList) {
      if ($im eq $m) {          #IGNOREMODS from component-level .krazy
	$found=1;
	last;
      }
    }
    push @modules, $m unless $found;
  }
}

# Let's doit!
&myMkdir("$destdir/$comp");

my(@subdirs);
for $m (@modules) {
  print "  [$m]\n";
  &myMkdir("$destdir/$comp/$m");

  @subdirs = ();
  if ( -f "$trunk/$comp/$m/CMakeLists.txt" ) {
    &subdirsFromCMakeList("$trunk/$comp/$m/CMakeLists.txt");
  } else {
    if ( -f "$trunk/$comp/$m/subdirs" ) {
      &subdirsFromSubdirs("$trunk/$comp/$m/subdirs");
    } else {
      &subdirsFromAll("$trunk/$comp/$m");
    }
  }
  &mergeModuleSettings("$trunk/$comp/$m");
  &doItForList("$m",$compId,$toolId,$generation);
}

# Update our generation field in the tools table.
&execSql("\"UPDATE tools SET generation=$generation WHERE id=$toolId;\"");

# Put a summary of this run into the generations table.
my($now)=`date "+%B %d %Y %T"`;
chomp $now;
&execSql("\"INSERT INTO generations VALUES ($generation, '$now', (SELECT SUM(issues) FROM results_krazy WHERE component='$compId' AND generation=$generation), $toolId, $svnRev );\"");


#==============================================================================

#override global settings from component-level directives
sub overrideSettings(){
  my($rc) = @_;
  my(@tmplist,$tmpstr);

  @tmplist=&ignoremodsList($rc);

  @gIgModsList=@tmplist if ($#tmplist >= 0);

  @tmplist=&ignoresubsList($rc);
  @gIgSubsList=@tmplist if ($#tmplist >= 0);

  $tmpstr=&skipRegex($rc);
  $gSkipRegex=$tmpstr if ($tmpstr);

  #do not allow CHECK at the component-level
  #@tmplist=&checkList($rc);
  #@gCheckList=@tmplist if ($#tmplist >= 0);

  @tmplist=&excludeList($rc);
  @gExcludeList=@tmplist if ($#tmplist >= 0);
}

#merge global settings with module-level directives
sub mergeModuleSettings(){
  my($rc) = @_;
  my($tmpstr);

  @mIgSubsList = @gIgSubsList;
  push(@mIgSubsList, &ignoresubsList($rc));
  &dedupe(@mIgSubsList);

  $mSkipRegex = $gSkipRegex;
  $tmpstr=&skipRegex($rc);
  if ($mSkipRegex ne $defRegex) {
    $mSkipRegex = $mSkipRegex . "\\|" . $tmpstr if ($tmpstr);
  } else {
    $mSkipRegex = $tmpstr if ($tmpstr);
  }

  @mCheckList = @gCheckList;
  push(@mCheckList, &checkList($rc));
  &dedupe(@mCheckList);

  @mExcludeList = @gExcludeList;
  push(@mExcludeList, &excludeList($rc));
  &dedupe(@mExcludeList);
}

#merge module-level directives with subdir-level directives
sub mergeSubdirSettings(){
  my($rc) = @_;
  my($tmpstr);

  $sSkipRegex = $mSkipRegex;
  $tmpstr = &skipRegex($rc);
  if ($sSkipRegex ne $defRegex) {
    $sSkipRegex=$sSkipRegex . "\\|" . $tmpstr if ($tmpstr);
  } else {
    $sSkipRegex = $tmpstr if ($tmpstr);
  }

  @sCheckList = @mCheckList;
  push(@sCheckList, &checkList($rc));
  &dedupe(@sCheckList);

  @sExcludeList = @mExcludeList;
  push(@sExcludeList, &excludeList($rc));
  &dedupe(@sExcludeList);
}

sub doItForList() {
  my($module, # module
     $compId, # componentId
     $toolId, # toolId
     $generation
    ) = @_;

  my($s,$is);
  my($checksum);
  my($out,@issues,$iss);
  if ( $#subdirs >= 0 ) {
    for $s (@subdirs) {

      $out = "$destdir/$comp/$module/$s";
      &myMkdir("$out");
      $checksum = 0; $iss = 0;
      if ( &inIgnoreSubs($s) ) {
	print "    Ignoring $comp/$module/$s\n";
	&createIgnorePage("$out","$comp/$module/$s");
      } else {
	&mergeSubdirSettings("$trunk/$comp/$module/$s");
	&doIt("$trunk/$comp/$module/$s","$out","$comp/$module/$s");
	if (-f "$out/index.html" && `grep "Total Issues" $out/index.html` ) {
	  (@issues) = split(" ",`grep "Total Issues" $out/index.html | head -1`);
	  $iss = $issues[3];
	  #compute checksum (grep out the date, which changes every run)
	  ($checksum) = split(" ",`grep -v "\.\.\.as of" $out/index.html | $md5`);
	}
      }
      &execSql("\"INSERT INTO results_krazy (checksum, issues, report, component, module, application, generation ) VALUES ( '$checksum', $iss, '$comp/$module/$s/index.html', '$compId', '$module', '$s', $generation );\"");
    }
  }
}

sub doIt() {
  my($in,    # dir to process
     $out,   # dir to write the report
     $cms    # component/module/subdir
    ) = @_;

  my($t);

  #subtract checkList from excludeList
  &removeChecksFromExcludes();
  #turn array into comma-separated string
  $t = &arrayToCSL(@sExcludeList);
  my($exclude) = "";
  $exclude = "--exclude=$t" if ($t);

  my($skip) = $sSkipRegex;
  if ($skip ne $defRegex) {
    print "    Processing $cms (without $skip)\n";
  } else {
    print "    Processing $cms\n";
  }

  system("cd $in; find . -name '*.cpp' -o -name '*.cc' -o -name '*.cxx' -o -name '*.c' -o -name '*.h' -o -name '*.hxx' | grep -v '$skip' | xargs env KRAZY_PLUGIN_PATH=$plgpth $krazy --export=ebn --explain --title \"Results for $cms\" --cms $cms $exclude > $out/index.html");
}

#search for ignoremods directive (comma-separated list) in this directory
# ignoremods kdebindings,kde-common
#!!currently absolutely no error checking, so the user better be careful.
#!!only makes sense in the global .krazy
sub ignoremodsList() {
  my($f) = @_;
  $f .= "/.krazy";
  open(F, "$f") || return;
  my($line,$ig,$vals,@vals);
  while ($line = <F>) {
    $line =~ s/#.*//;
    ($ig,$vals) = split(" ",$line);
    $ig = uc($ig);
    if ($ig eq "IGNOREMODS") {
      @vals=split(",",$vals);
      &dedupe(@vals);
      return @vals;
    }
  }
  close(F);
  return;
}

#search for ignoresubs directive (comma-separated list) in this directory
# ignoresubs cmake,.svn,pics
#!!currently absolutely no error checking, so the user better be careful.
#!!only makes sense in the global .krazy, or in a module .krazy
sub ignoresubsList() {
  my($f) = @_;
  $f .= "/.krazy";
  open(F, "$f") || return;
  my($line,$ig,$vals,@vals);
  while ($line = <F>) {
    $line =~ s/#.*//;
    ($ig,$vals) = split(" ",$line);
    $ig = uc($ig);
    if ($ig eq "IGNORESUBS") {
      @vals=split(",",$vals);
      &dedupe(@vals);
      return @vals;
    }
  }
  close(F);
  return;
}

#search for exclude directive (comma-separated list) in this directory
# EXCLUDE spelling,qminmax
#!!currently absolutely no error checking, so the user better be careful.
sub excludeList() {
  my($f) = @_;
  $f .= "/.krazy";
  open(F, "$f") || return;
  my($line,$ex,$vals,@vals);
  while ($line = <F>) {
    $line =~ s/#.*//;
    ($ex,$vals) = split(" ",$line);
    $ex = uc($ex);
    if ($ex eq "EXCLUDE") {
      @vals=split(",",$vals);
      &dedupe(@vals);
      return @vals;
    }
  }
  close(F);
  return;
}

#search for check directive (comma-separated list) in this directory
# CHECK spelling,qminmax
#!!currently absolutely no error checking, so the user better be careful.
sub checkList() {
  my($f) = @_;
  $f .= "/.krazy";
  open(F, "$f") || return;
  my($line,$ck,$vals,@vals);
  while ($line = <F>) {
    $line =~ s/#.*//;
    ($ck,$vals) = split(" ",$line);
    $ck = uc($ck);
    if ($ck eq "CHECK") {
      @vals=split(",",$vals);
      &dedupe(@vals);
      return @vals;
    }
  }
  close(F);
  return;
}

#search for skip directive in this directory
# SKIP /kjs/
# SKIP /kjs/\|/kdeui/\|/kdefoo/
#!!currently absolutely no error checking, so the user better be careful.
sub skipRegex() {
  my($f) = @_;
  $f .= "/.krazy";
  open(F, "$f") || return;
  my($line,$sk,$vals);
  while ($line = <F>) {
    $line =~ s/#.*//;
    ($sk,$vals) = split(" ",$line);
    $sk = uc($sk);
    return $vals if ($sk eq "SKIP");
  }
  close(F);
  return;
}

sub subdirsFromCMakeList() {
  my($f) = @_;
  open(F, "$f") || die "Couldn't open $f";
  my($line);
  while ($line = <F>) {
    next unless ($line =~ m/add_subdirectory/);
    $line =~ s/add_subdirectory\(\s+(\S+)\s+\)/$1/;
    $line =~ s/add_subdirectory\((\S+)\)/$1/;
    $line =~ s/^\s+//;
    $line =~ s/\s+$//;
    $line =~ s/^#[[:space:]]*//;   #yes, process "commented out for now" subdirs too
    push(@subdirs,$line);
  }
  close(F);
}

sub subdirsFromSubdirs() {
  my($f) = @_;
  (@subdirs) = split("[[:space:]]",`cat $f`);
}

sub subdirsFromAll() {
  my($d) = @_;
  my($s);
  opendir(DIR,"$d") or die "cannot open $d: $!";
  while (defined($s = readdir(DIR))) {
    next unless (-d "$d/$s");
    next if (-l "$d/$s");        #skip symlinks
    next if ($s eq ".");         #skip cwd
    next if ($s eq "..");        #skip parent dir
    next if ($s =~ /svn/);       #skip .svn
    next if ($s =~ /build/);     #skip build dirs
    next if ($s eq "admin");
    next if ($s eq "cmake");
    next if ($s eq "CMakeFiles");
    next if ($s eq "doc");
    next if ($s eq ".libs");
    next if ($s eq "Testing");
    next if ($s eq "lib");
    next if ($s eq "bin");
    next if ($s eq "pics");
    next if ($s eq "m4");
    push(@subdirs,$s);
  }
}

# remove duplicate entries from a list
sub dedupe() {
  my(@list) = @_;
  my(%seen) = ();
  my(@uniq,$item);
  foreach $item (@list) {
    push(@uniq, $item) unless $seen{$item}++;
  }
  @list = @uniq;
}

sub removeChecksFromExcludes() {
  my(%count) = ();
  my(@diff,$item);
  foreach $item (@sExcludeList, @sCheckList) {
    $count{$item}++;
  }
  foreach $item (@sExcludeList) {
    if ($count{$item} == 1) {
      push(@diff, $item);
    }
  }
  @sExcludeList = @diff;
}

# determine if $s is found in @mIgSubsList
sub inIgnoreSubs() {
  my($s) = @_;
  my($item);
  foreach $item (@mIgSubsList) {
    return 1 if ($s eq $item);
  }
  return 0;
}

# turn array into a comma-separated list
sub arrayToCSL() {
  my(@list) = @_;
  my($item);
  my($s)="";
  foreach $item (@list) {
    $s .= $item . ",";
  }
  $s =~ s/,$//;
  return $s;
}

sub myMkdir() {
  my($d) = @_;
  if (! -d "$d") {
    mkpath("$d") || die "$d: $!\n";
  }
}

sub execSql() {
  if ($PSQL) {
    if ($PSQL ne "debug") {
      return `echo @_ | $PSQL -t -h services.codeyard.net -U kde kde -A -q`;
    } else {
      print "echo @_ | PSQL -t -h services.codeyard.net -U kde kde -A -q\n";
    }
  }
}

# asOf function: return nicely formatted string containing the current time
sub asOf{
  return strftime("%B %d %Y %H:%M:%S", localtime(time()));
}

# createIgnorePage: create an empty "ignore" page.
sub createIgnorePage{
  my($outdir,$cms)=@_;
  my($f)="$outdir" . "/index.html";
  open(F, ">$f") || return;
  my($title)="Results for " . "$cms";
print "$title\n";
  my($component,$module,$subdir)=split("/",$cms);
  my($upcomp) = uc($component);
  $upcomp =~ s/-/ /;

  print F "<html>\n";
  print F "<head>\n";
  print F "<title>$title</title>\n";
  print F "<link rel=\"stylesheet\" type=\"text/css\" title=\"Normal\" href=\"/style.css\" />\n";
  print F "</head>\n";
  print F "<body>\n";
  print F "<div id=\"title\">\n";
  print F "<div class=\"logo\">&nbsp;</div>\n";
  print F "<div class=\"header\">\n";
  print F "<h1><a href=\"/\">English Breakfast Network</a></h1>\n";
  print F "<p><a href=\"/\">Almost, but not quite, entirely unlike tea.</a></p>\n";
  print F "</div>\n";
  print F "</div>\n";
  print F "<div id=\"content\">\n";
  print F "<div class=\"inside\">\n";

  # Breadcrumbs
#   print F "<p style=\"font-size: x-small;font-style: sans-serif;\">\n";
#   print F "<a href=\"/index.php\">Home</a>&nbsp;&gt;&nbsp;\n";
#   print F "<a href=\"/$Prog/index.php\">Source Code Sanitizer Results</a>&nbsp;&gt;&nbsp;\n";
#   print F "<a href=\"/$Prog/index.php?component=$component\">$upcomp</a>&nbsp;&gt;&nbsp;\n" if ($component);
#   print F "<a href=\"/$Prog/index.php?component=$component&module=$module\">$module</a>&nbsp;&gt;&nbsp;\n" if ($component && $module);
#   print F "$subdir\n" if ($subdir);
#   print F "</p>\n";

  # Links to other available reports
  if ($component && $module && $subdir) {
    print F "<p style=\"font-size: x-small;font-style: sans-serif;\">\n";
    print F "Other $module/$subdir reports:\n";
    print F "[<a href=\"/apidocs/apidox-$component/$module-$subdir.html\">APIDOX</a>]\n";
    print F "[<a href=\"/sanitizer/reports/$component/$module/$subdir/index.html\">Docs</a>]\n";
    print F "</p>\n";
  }

  print F "<h1>$title</h1>\n";
  print F "<p>Not processed per IGNORESUBS directive found in $component/.krazy or $module/.krazy file.<br>\n";

  print F " ...as of "; print F &asOf(); print F "</p>\n";
  print F "<ol>\n";

  print F "</ol>\n";
  print F "</div>\n";
  print F "</div>\n";
  print F "<div id=\"footer\">\n";
  print F "<p>Site content Copyright 2005-2007 by Adriaan de Groot,<br/>\n";
  print F "except images as indicated.</p>\n";
  print F "</div>\n";
  print F "</body>\n";
  print F "</html>\n";

  close F;
}

#==============================================================================
# Help function: print help message and exit.
sub Help {
  &Version();
  print "KDE source code checking for the English Breakfast Network (EBN)\n\n";
  print "Usage: $Prog [OPTION]... FILE...\n";
  print "  --help             display help message and exit\n";
  print "  --version          display version information and exit\n";
  print "  --component        component to process (default=\"$comp\")\n";
  print "\n";
  exit 0 if $help;
}

# Version function: print the version number and exit.
sub Version {
  print "$Prog, version $VERSION\n";
  exit 0 if $version;
}
