do_fhem/fhem/core/contrib/pre-commit

#!/usr/bin/perl
# $Id: commandref_join.pl 5361 2014-03-29 06:24:20Z rudolfkoenig $

use strict;
use warnings;
sub err($$);

my $svnlook='/usr/bin/svnlook';
my $repos=$ARGV[0];
my $txn=$ARGV[1];
my $arg="-t $txn";
#my $arg="-r $txn";      # local testing
my @lang = ("EN", "DE");
my $exitCode = 0;
use constant TAGS => qw{ul li code b i u td tr table div};

my $log = `$svnlook log $arg $repos`;
if($log !~ m/^.*:.*$/s) {
  print STDERR << 'EOF';
A FHEM SVN comment must have the following format
  module: text-describing-the-change
or
  module: text-describing-the-change (Forum #<forum.fhem.de threadnumber>)
EOF
  exit(1);
}

my $fList = `$svnlook changed $arg $repos`;
foreach my $row (split("\n", $fList)) {
  chomp($row);
  my ($type, $fName) = split(" ", $row);
  next if($type eq "D");
  next if(!$fName);

  # check for 80 chars per line conformity
  if($fName =~ m/CHANGED/) {
    my ($cCount, $cLineNo, $tLineNo, $lineNo) = (0,0,0,0,0);
    open(FILE, "$svnlook $arg cat $repos $fName|") ||
        die("Cant svnlook cat $fName:$!\n");
    while(my $l = <FILE>) {
      chomp $l;
      $lineNo++;
      $tLineNo = $lineNo if(!$tLineNo && $l =~ /\t/) ;
      if(length($l) > 80 && !$cLineNo) {
        $cCount = length($l);
        $cLineNo = $lineNo;
      }
      last if($cLineNo && $tLineNo);
    }
    close(FILE);
    err $fName, "file contains tabulators in line $tLineNo" if($tLineNo);
    err $fName, "file has over 80 chars/line in line $cLineNo" if($cLineNo);
    next;
  }
  
  next unless($fName =~ /\.pm$/);

  # check for SVN Id
  if($fName =~ m,trunk/fhem/FHEM/[^/]+\.pm$,) {
    my $hasId = 0;
    open(FILE, "$svnlook $arg cat $repos $fName|") ||
        die("Cant svnlook cat $fName:$!\n");

    while(my $l = <FILE>) {
       $hasId = ($l =~ /#.*?\$Id(?:\:.+)?\$/);
       last if($hasId);
    }
    close(FILE);
    err $fName, "file has no SVN Id as comment" unless($hasId);

    # check for activated Id property in svn:keywords
    my $props = `$svnlook $arg propget $repos svn:keywords $fName`;

    err $fName, "Id property not set in svn:keywords"
      unless($props =~ /Id/);
  }

  next if($fName !~ m+FHEM/(\d\d)_(.*).pm$+);
  my ($modNum, $modName) = ($1, $2);
  my %ninetyniners = ("SUNRISE_EL"=>1, "Utils"=>1);
  err $fName, "99 is a reserved prefix, not allowed for $modName"
    if($modNum eq "99" && !$ninetyniners{$modName});

  foreach my $lang (@lang) {
    my $suffix = ($lang eq "EN" ? "" : "_$lang");
    my $tag;
    my %tagcount= ();
    my %llwct = (); # Last line with closed tag
    open(MOD, "$svnlook $arg cat $repos $fName|") ||
        die("Cant svnlook cat $fName:$!\n");
    my $skip = 1;
    my $line = 0;
    my $docCount = 0;
    my $hasLink = 0;
    my $hasSummary = 0;

    while(my $l = <MOD>) {
      $line++;

      err $fName, "DOS line encoding is not supported."
        if($l =~ m/^=begin html$suffix.*\r/);

      if($l =~ m/^=item summary$suffix\s+(.+?)\s*$/) {
        err $fName, "$lang: summary is longer than 80 chars on line $line"
          if(length($1) > 80);
        $hasSummary = 1;
      }

      if($l =~ m/^=begin html$suffix$/) {
        $l = <MOD>;    # skip one line, to be able to repeat join+split
        err($fName, "$lang: nonempty line after =begin html.")
          if($l =~ m/^...*$/);
        $skip = 0; $line++;

      } elsif($l =~ m/^=end html$suffix$/) {
        $skip = 1;

      } elsif(!$skip) {
        $docCount++;
        $hasLink = ($l =~ m/<a name="$modName"/) if(!$hasLink);
        foreach $tag (TAGS) {
          my $ot = ($tagcount{$tag} ? $tagcount{$tag} : 0);
          $tagcount{$tag} +=()= ($l =~ /<$tag>/gi);
          $tagcount{$tag} -=()= ($l =~ /<\/$tag>/gi);
          $llwct{$tag} = $line if(!$llwct{$tag} || ($ot && !$tagcount{$tag}));
        }
      }
    }
    close(MOD);

    err $fName, "$lang: No document text found"
      if(!$suffix && !$docCount);
    err $fName, "$lang: No <a name=\"$modName\"> link"
      if(!$suffix && $docCount && !$hasLink);
    err $fName, "$lang: No summary description found"
      if(!$suffix && $docCount && !$hasSummary);

    foreach $tag (TAGS) {
      err $fName, "$lang: Unbalanced $tag ($tagcount{$tag}, last line ok: $llwct{$tag})"
        if($tagcount{$tag});
    }
  }
}

exit($exitCode);

sub
err($$)
{
  my ($fName, $txt) = @_;
  print STDERR "*** $fName: $txt\n";
  $exitCode = 1;
}