#!/usr/bin/perl -w

# suck.pl - stop code that sucks!
# This is a program that checks for adherence to Digpro's style guide
# for java. 
# If invoked with -l, check for text in swedish. 

# @author mailto:fw@digpro.se Fredrik Widlert

use strict;

my $langcheck = 0;
my $error = 0;

die "usage: suck.pl [-l] <name_of_file_sent_on_stdin>\n" unless @ARGV;

while (defined $ARGV[0] and $ARGV[0] =~ /^-([l]+)/) {
    my $vars = $1;
    if ($vars =~ /l/) {
	$langcheck = 1;
    }
    shift @ARGV;
}


my $filename = shift @ARGV;

check_file ($filename);

exit $error;

sub err {
  my $msg = shift;
  $msg =~ s/å|ä|ö|Å|Ä|Ö/?/g;  # swedish makes svn hang?!?
  $msg =~ s/\\\\/\\?/g; # double backslash seems evil as well
  print "$msg\n";
  $error = 1;
}

sub parse_line {
  my $str = shift;
  return ("unknown", $str);
}

sub check_package_use {
  my ($file, $row, $line, $package, $used_package) = @_;
  if ($package =~ /^bios/ and !($file =~ m!/junit/!)) {
    if ($used_package =~ /^(sys|app)/) {
      err ("$file $row: bios may not use app or sys: $line");
    }
  } elsif ($package =~ /^sys/ and !($file =~ m!/junit/!)) {
    if ($used_package  =~ /^app/) {
      err ("$file $row: sys may not use app: $line");
    }
  }
}

sub check_file {
  my $file = shift;

  my $line;
  my $user;
  my $comment = 0;
  my $author = 0;
  my $version = 0;
  my $package = "";
  my $len;
  my $row = 0;
  my $last_was_brace = 0;
  my $last_was_endbrace = 0;
  my $last_was_semicolon = 0;
  my $last_indent = 0;

  while (<>) {
    $row++;

    s/ {0,7}\t/        /g;
    ($user, $line) = parse_line($_);
    chomp ($line);

    if ($line =~ /^\s*package\s+(.*);/) {
      $package = $1;
    }

    # check for illegal imports
    if ($line =~ /^\s*import\s+(.*);/) {
      check_package_use ($file, $row, $line, $package, $1);
    }

    # check for illegal server calls
    if ($line =~ m!\"(app|sys)/\w+:.*?\"!) {
      check_package_use ($file, $row, $line, $package, $1) unless ($line =~ m!^\s*(\*|/)!);
    }

    # check for javadoc
    if ($line =~ /\/\*\*/) {
      $comment = 1;
    }

    #check for @author
    if ($line =~ /\@author.*mailto/i) {
      $author = 1;
    } elsif ($langcheck) {
      if ($line =~ /[åäöÅÄÖ]| och |visa|skriv|avbryt|slut| den | till |punkt|koordinat|objekt/i) {
	# subversion spews on swedish characters, so do not show them...
	err ("$file $row: SWEDISH: $line") unless ($line =~ /NOLANG/);
      }
    }

    #check for @version
    if ($line =~ /\@version.*\$Id.*\$/i) {
      err ("$file: Version tag no longer supported, please remove it from all java files you commit");
    }

    # checks done once for each class
    if ($line =~ /^\s*public(\s+abstract)?\s+class/) {
      if ($comment == 0) {
	$comment = -1;
	err ("$file: Missing javadoc comment [$user]");
      } else {
	if ($author == 0) {
	  err ("$file: \@author missing or without mailto: in javadoc [$user]");
	}
      }
    }

    # check line length
    $len = length ($line) - 1;
    if ($len > 100) {
      err ("$file $row: $len chars [$user]) $line");
    }

    # un-uncomment this to check for one-line ifs
    if ($line =~ /^\s*if \(.*;\s*$/) {
      err ("$file $row: one-liner: $line");
    }

    # check indentation
    if ($line =~ /\S/) { 

      $line =~ /(^\s*)/;
      my $indent = length ($1);    

      if ($last_was_brace && $indent < ($last_indent + 4)) {
	if (!$line =~ /\}/) {
	  err ("$file $row: indentation error (after brace)");
	}
      } elsif ($last_was_semicolon && $indent > $last_indent) {
	err ("$file $row: indentation error (after semicolon)");

      }
      if ($last_was_endbrace && ($line =~ /^\s*(else|catch|finally)\s*\{?/)) {
	err ("$file $row: $1 on new line after end brace.");
      }

      if ($line =~ /^\s*try\s*$/) {
	err ("$file $row: try without brace on the same line\n");
      }

      $last_was_semicolon = $line =~ m!\;\s*(//.*)?$!;
      if ($line =~ /case/) {
	$last_was_semicolon = 0;
      }
      $last_was_brace = $line =~ m!(public |protected | private |if |for |while ).*\{\s*(//.*)?$!;
      $last_was_endbrace = $line =~ m!\}\s*(//.*)?$!;

      $last_indent = $indent;
    }

    # check for names beginning with _
    if ($line =~ /\s_/ and !($line =~ m!//|\*!)) {
      err ("$file $row: name beginning with underscore? (see the Style guide): $line");
    }

    # check for missing whitespace
    if ($line =~ /^[^*"]*[a-z0-9]\(/) {
      err ("$file $row: missing whitespace: $line");
    }

    # check for extra whitespace
    if ($line =~ /\S\s+;/) {
      err ("$file $row: extra whitespace before semicolon: $line");
    }

    # TODO: this should work, but svn seems to hang??? Test some more and reenable.
    # check for extra whitespace after parenthesis
    #if ($line =~ /\(\s/ && !($line =~ /"/)) {
    #  err ("$file $row: extra whitespace: $line");
    #}

    # check for missing space after comma
    if ($line =~ /,(\w|\d)/ && !($line =~ /@|"|\$|^\s+\*|^\s+\/\*/)) {
      err ("$file $row: missing whitespace after comma: $line");
    }
  }
}