sh-check-references

#!/usr/bin/perl

use strict;
use warnings;
use encoding 'utf-8';

use Parse;
use Data::Dumper;

my $good = "\e[32;1m+\e[0m\e[2K\e[1G";
# my $good = "\e[32;1m+\e[0m\n";
# my $unknown = "\e[33;1m?\e[0m\n";
my $unknown = "\e[33;1m?\e[0m\n";
my $bad = "\e[31;1m-\e[0m\e[2K\e[1G";
# my $bad = "\e[31;1m-\e[0m\n";
my $report = 1;

for my $lawFile (glob 'data/sh/laws/*.html') {
  Parse::parseHTMLSH($lawFile);
}

my @toCheck = values %{Parse::all()};
# @toCheck = grep { $_->{'veryshorthand'} =~ /AmrumWasSchGebV/ } @toCheck;

for my $lawFile (glob 'data/laws/*.html') {
  Parse::parseHTML($lawFile);
}

my $allShorthands = join '|', sort { length($b) <=> length($a) } grep { $_ =~ /^[1-9a-zäöüßA-ZÄÖÜ. ]+$/s } map { $_->{'veryshorthand'} } values %{Parse::all()};
my $someLaw = qr(Grundbuchverfügung|Binnenschifffahrtsstraßen-Ordnung|Lebensmittel-, Bedarfsgegenstände- und Futtermittelgesetzbuchs?|Kraft-Wärme-Koppe?lungsgesetz|Gesetz über die Kontrolle von Kriegswaffen|Justizvergütungs- und -entschädigungsgesetzes|Forstschäden-Ausgleichsgesetz|(?:[A-Za-zäöüÄÖÜ-]+ Buches |[A-Za-zäöüÄÖÜ-]+\s+|[A-Za-zäöüÄÖÜ-]+- und -?)?(?:[A-ZÄÖÜß0-9][A-Za-zäöüÄÖÜß0-9-]+(?:ordnung|gesetz)|Ordnung\b|Gesetz)[A-Za-zäöüÄÖÜß0-9-]*|[A-Za-zäöüÄÖÜ-]+ Buche?s?\b|$allShorthands);

# die Dumper(['Verordnung zur Einführung der Binnenschifffahrtsstraßen-Ordnung' =~ /(?:der|des)\s*($someLaw)/]);
# die "Telekommunikations-Überwachungsverordnung" =~ m/^$someLaw$/;

my $oldExternalLaw = undef;
my %buchNumeric = initBuchNumeric();
my %deletedLaws = initDeletedLaws();
my %lawNameExpansion = initLawNameExpansion();

foreach my $law (sort { $a->{'veryshorthand'} cmp $b->{'veryshorthand'} } @toCheck) {
  foreach my $paragraph (@{$law->{'paragraph'}}) {
    $oldExternalLaw = undef;

    foreach my $absatz (@{$paragraph->{'absatz'}}) {
      checkReferences($law, $paragraph, $absatz, $absatz->{'text'});
    }
  }
}

sub checkReferences {
  my ($law, $paragraph, $absatz, $text) = @_;

  $text =~ s/Abs\./Absatz/g;
  $text =~ s/Nr\./Nummer/g;

  if($text =~ /zukünftig in Kraft/) {
    # nobody expects this to be consistent
    return;
  }

  # print "$text\n";

  my $globalExternalLaw = undef;
  if($law->{'name'} =~ /(?:der|des|dem|zum)\s*($someLaw)/) {
    $globalExternalLaw = $1;
  }

  my $externalLaw = undef;

  my $any = 1;
  while($any) {
    $any = 0;

    if($text =~ /($someLaw)[ :.;,](.*)/s) {
      $externalLaw = $1;
      $text = $2;
      $any = 1;
      next;
    }

    if($text =~ /§ (\d+[a-z]*\.?\d*)(?: ff\.)?(.*)/s) {
      my $refParagraph = $1;
      $text = $2;

      $refParagraph =~ s/\.$//;
      $refParagraph =~ s/ff$//;

      my $refAbsatz = undef;

      if($text =~ /^\s*Absatz(\s*\d+[a-z]*|\s*,|\s*und)*(.*)/s) {
        my $absatz = $1;
        $text = $2;

        while($absatz =~ /(\d+[a-z]*)(.*)/) {
          push @$refAbsatz, $1;
          $absatz = $2;
        }
      }

      foreach my $a (defined $refAbsatz? @$refAbsatz: (undef)) {
        if($text =~ /^\s*(?:gilt auch für|findet.*Anwendung)/) {
          # this cannot be rescued by later external mentions
        } else {
          if($text =~ /^(?:\s*Satz (\d+))?(?:[^.\(]{0,200}?|[^.\(]*?\([^\(]*?\)[^.\(]*?)(?:\s+der|\s+des)?\s+($someLaw)/) {
            $externalLaw = $2;
            if(checkAbsoluteReference($law, $paragraph, $absatz, $externalLaw, $refParagraph, $a)) {
              $any = 1;
              next;
            }
          }
          if($text =~ /^(?:\s*Satz (\d+))?(?:.*)\s+($someLaw)/) {
            $externalLaw = $2;
          }
          if($externalLaw) {
            if(checkAbsoluteReference($law, $paragraph, $absatz, $externalLaw, $refParagraph, $a)) {
              $any = 1;
              next;
            }
          }
          if($globalExternalLaw) {
            if(checkAbsoluteReference($law, $paragraph, $absatz, $globalExternalLaw, $refParagraph, $a)) {
              $any = 1;
              next;
            }
          }
        }

        $any = 1;

        unless(checkAbsoluteReference($law, $paragraph, $absatz, $law->{'veryshorthand'}, $refParagraph, $a)) {
          my $oldBad = $bad;
          $bad = "\e[31;1m!!!\e[0m\n";
          checkAbsoluteReference($law, $paragraph, $absatz, $law->{'veryshorthand'}, $refParagraph, $a);
          $bad = $oldBad;
          if($text =~ /Fassung/) {
            # this might be a weird temporary regulation
            print "\e[33;1m^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (old)\e[0m\n" if $report;
          } elsif(defined $oldExternalLaw and checkAbsoluteReference($law, $paragraph, $absatz, $oldExternalLaw, $refParagraph, $a)) {
            # Orr...
            print "\e[33;1m^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ (dislocated reference)\e[0m\n" if $report;
          } else {
            print "Name: " . $law->{'name'} . "\n" if $report;
            print "VSH: " . $law->{'veryshorthand'} . "\n" if $report;
            print "Context (E): " . $externalLaw . "\n" if defined $externalLaw and $report;
            print "Context (OE): " . $oldExternalLaw . "\n" if defined $oldExternalLaw and $report;
            print "Context (GE): " . $globalExternalLaw . "\n" if defined $globalExternalLaw and $report;
            print "\e[31;1m^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^\e[0m\n" if $report;
          }
        }
      }
    }
#  while($text =~ /(Absatz \d+[a-z]*) (.*)$/s) {
#    $text = $2;
#
#    print "Reference: $1\n";
  }

  $oldExternalLaw = $externalLaw;
}

sub location {
  my ($law, $paragraph, $absatz) = @_;

  my $location = $law->{'veryshorthand'};
  if(defined $paragraph and exists $paragraph->{'number'}) {
    $location .= " § " . $paragraph->{'number'};
  }
  if(defined $absatz and exists $absatz->{'number'}) {
    $location .= " Abs. " . $absatz->{'number'};
  }

  return $location;
}

sub checkAbsoluteReference {
  my ($sourceLaw, $sourceParagraph, $sourceAbsatz, $lawName, $paragraph, $absatz) = @_;

  my $source = location($sourceLaw, $sourceParagraph, $sourceAbsatz);

  my @law = grep { $_->{'name'} eq $lawName } values %{Parse::all()};
  if(not @law) {
    @law = grep { $_->{'veryshorthand'} eq $lawName } values %{Parse::all()};
  }

  if(not @law) {
    $lawName =~ s/^(des|der|die|das|dem|einer?m?|diese?s?m?|durch|kraft|von) //is;

    @law = grep { $_->{'name'} eq $lawName } values %{Parse::all()};
  }
  if(not @law) {
    @law = grep { $_->{'veryshorthand'} eq $lawName } values %{Parse::all()};
  }

  if(not @law) {
    $lawName =~ s/lichen /liches /;
    $lawName =~ s/Gesetzes/Gesetz/;
    $lawName =~ s/gesetzes/gesetz/;
    $lawName =~ s/buches$/buch/;
    $lawName =~ s/buchs$/buch/;
    $lawName =~ s/buche$/buch/;
    $lawName =~ s/n Buches /s Buch /;
    $lawName =~ s/n Buches$/s Buch/;
    $lawName =~ s/n Buch /s Buch /;
    $lawName =~ s/n Buch$/s Buch/;
    $lawName =~ s/Buches /Buch /;
    $lawName =~ s/Buchs$/Buch/;
    $lawName =~ s/Buche$/Buch/;
    $lawName =~ s/zwanzigsten /zwanzigstes /;
    $lawName =~ s/Zweiten /Zweite / if $lawName =~ /verordnung/i;
    $lawName =~ s/Zweiten /Zweites / if $lawName =~ /gesetz/i;
    $lawName =~ s/läufigen /läufiges /;
    $lawName =~ s/Deutschen /Deutsches /;

    @law = grep { $_->{'name'} eq $lawName } values %{Parse::all()};
  }
  if(not @law and $lawName =~ /Buch$/ and $sourceLaw->{'veryshorthand'} =~ /^SGB/) {
    if(exists $buchNumeric{$lawName}) {
      $lawName = "SGB " . $buchNumeric{$lawName};
      @law = grep { $_->{'veryshorthand'} eq $lawName } values %{Parse::all()};
    }
    # die "$lawName not resolved" unless @law;
  }
  if(not @law and $lawName =~ /^([A-Za-zäöüÄÖÜ]+ Buch) Sozialgesetzbuch$/) {
    my $book = $1;
    if(exists $buchNumeric{$book}) {
      $lawName = "SGB " . $buchNumeric{$book};
      @law = grep { $_->{'veryshorthand'} eq $lawName } values %{Parse::all()};
    }
    # die "$lawName not resolved" unless @law;
  }
  if(not @law) {
    @law = grep { $_->{'name'} =~ m/^$lawName\s*\*\)/ } values %{Parse::all()};
  }
  if(not @law) {
    $lawName =~ s/ss/ß/g;
    @law = grep { $_->{'name'} eq $lawName } values %{Parse::all()};
  }
  if(not @law) {
    $lawName =~ s/ß/ss/g;
    @law = grep { $_->{'name'} eq $lawName } values %{Parse::all()};
  }
  if(not @law) {
    @law = grep { $_->{'shorthand'} =~ /$lawName/ } values %{Parse::all()};
  }
  if(not @law) {
    @law = grep { $_->{'veryshorthand'} =~ /$lawName/ } values %{Parse::all()};
  }
  if(not @law and exists $lawNameExpansion{$lawName}) {
    @law = grep { $_->{'veryshorthand'} eq $lawNameExpansion{$lawName} } values %{Parse::all()};
  }
  if($lawName =~ /^[a-zäöü-]/ or $lawName =~ /-$/) {
    return 0;
  }
  if($lawName =~ /^(Gesetze?s?n?|Rechtsverordnunge?n?|Beiordnung|Verordnung|Grund Gesetz|Grund Landesgesetze?|Landesgesetze?|Landesbesoldungsgesetze?|Buche?s?|In Rechtsverordnungen|Soweit Rechtsverordnunge?n?|Steuergesetze|Gesetzliche|Bundesrates Rechtsverordnungen|Ausführungsgesetz|Landesmeldegesetze|Gesetzgebung|Verwaltungsverfahrensgesetze|Datenschutzgesetze|Abordnung|Bauordnungsrechts?|Steueränderungsgesetz)$/) {
    return 0;
  }
  if($lawName =~ /(Änderungsgesetze?s?)$/) {
    return 0;
  }
  if(exists $deletedLaws{$lawName}) {
    return 0;
  }
  if($lawName =~ / Ordnung$|^Ordnung$/) {
    return 0;
  }
  if($lawName eq 'Grundgesetz' and $paragraph !~ /Artikel/) {
    return 0;
  }

  if($lawName =~ /^(Arrestanordnung|Errichtungsanordnung|Strafgesetz|Dateianordnung|Einführungsgesetz|Rechtsordnung|Einordnung|Verordnungen|Sportordnung|Ordnungsgeld|Gesetzbuch|Erst- und Verlängerungsanordnunge?n?|.*ordnungswidrigkeite?n?|Übertragungsanordnung|Ordnungsgeldes|Tagesordnung|Rangordnung|Geschäftsordnunge?n?|Ordnungsgeldvorschrift|Dienstordnungsverhältnis|Zuordnung|Landesgesetzgebung|Bundesgesetz|Hausordnung|Ruhensanordnung|Börsenordnung|Übermittlungsverordnung|Ordnungsgeldverfahren|Gebührenordnung|Kostenordnung|Umschulungsordnung|Ausbildungsordnung|Prüfungsordnunge?n?|Fortbildungsordnung|Überleitungsverordnung|Personalverordnung|Abschiedungsanordnung|Ordnungsmässigkeit|Wahlordnung|Berufsordnung|(?:Als )?Ordnungsmassnahmen?|Forderungsklassenzuordnung|Vorgesetztenverhältnisses|Zugangsanordnung|Verordnungskosten|Budgetverordnung|Vorgesetzten|Abschiebungsanordnung|Zuordnungsverfahren|Ordnungsnummer|Stellenzulagenverordnung|Ausbildungs- und Prüfungsverordnung|Zweiten Gesetze?s?|Zulassungsverordnungen|Reichsgesetzbl|Rechts- und Gesellschaftsordnung|Meisterprüfungsordnungen|Ausführungsanordnung|Aufklärungsanordnungen|Festgesetzte|Lager- und Verträglichkeitsgruppenzuordnung|Durchführungsverordnung|Folgeanordnungen|Ausbildungs- und Prüfungsordnungen|Bundesbesoldungsordnunge?n?|Raumordnung|Neuordnung|Gesellen- und Meisterprüfungsordnungen|Benutzungsanordnung|Weiterbildungsordnunge?n?|Verordnungsumfangs?|Versetzungs- und Abordnungsschutz|Aktivität Buch|Schiesssportordnunge?n?|Dienstordnung|Arzneimittelverordnungen|Verwaltungsanordnung|Reisekostenordnung)$/) {
    return 0;
  }
  if($lawName =~ /entgegengesetzt|eingesetzt|festgesetzt|Anordnung|fortgesetzt|Ordnungswidrig|ausgesetzt|vorgesetzt/) {
    return 0;
  }
  if(exists $buchNumeric{$lawName}) {
    # this is actually a local reference
    return 0;
  }

  if(not @law) {
    print "reference $lawName § $paragraph @ $source ";
    # print ((join "\n", map { $_->{'name'} } values %{Parse::all()}) . "\n");
    print "$unknown";
    return 1;
  }

  my $law = $law[0];

  if($absatz) {
    print "reference " . $law->{'veryshorthand'} . " § $paragraph Abs. $absatz @ $source ";
  } else {
    print "reference " . $law->{'veryshorthand'} . " § $paragraph @ $source ";
  }

  if(grep { $_->{'number'} eq $paragraph } @{$law->{'paragraph'}}) {
    print "$good";
  } else {
    print "$bad";
    return 0;
  }

  return 1;
}

sub initBuchNumeric {
  return (
    'Erstes Buch' => 1,
    'Zweites Buch' => 2,
    'Drittes Buch' => 3,
    'Viertes Buch' => 4,
    'Fünftes Buch' => 5,
    'Sechstes Buch' => 6,
    'Siebtes Buch' => 7,
    'Achtes Buch' => 8,
    'Neuntes Buch' => 9,
    'Zehntes Buch' => 'X',
    'Elftes Buch' => 11,
    'Zwölftes Buch' => 12,
  );
}

sub initDeletedLaws {
  return (
    'Bundessozialhilfegesetz' => 1,
    'Kriegsgefangenenentschädigungsgesetz' => 1, # http://buerger.thueringen.de/modules/bs/serviceportal/index.php?mode=static&OP[0][c]=contentdiv&OP[0][f]=search&OP[0][p][LLG_ID]=354994&dclp=a287b38a9cda2ee2b0aec651d64d7366&fs=0
    'Reichsapothekerordnung' => 1, # http://alex.onb.ac.at/cgi-content/alex?apm=0&aid=dra&datum=19370004&seite=00000457&zoom=2
    'Rechtsberatungsgesetz' => 1, # http://de.wikipedia.org/wiki/Rechtsberatungsgesetz => Rechtsdienstleistungsgesetz
    'Rechtsanwaltsgesetz' => 1, # http://www.gesetze-im-internet.de/einigvtr/BJNR208890990BJNE025800301.html
    'Schiffsbankgesetz' => 1, # http://www.google.com/url?sa=t&rct=j&q=gesetz%20%C3%BCber%20schiffspfandbriefbanken&source=web&cd=2&ved=0CFUQFjAB&url=http%3A%2F%2Fdip.bundestag.de%2Fbtd%2F15%2F043%2F1504321.pdf&ei=dMcCUN-lGZHEswbGs9WhBg&usg=AFQjCNHaYvSOwsxWQct29Xr-ZhdfSTrqkA&cad=rja
    'Gemeinnützigkeitsverordnung' => 1,
    'Strafregistergesetz' => 1, # http://www.gesetze-im-internet.de/bzrg/__64a.html
    'Bundesbaugesetz' => 1, # http://de.wikipedia.org/wiki/Baugesetzbuch
    'Seuchengesetz' => 1, # http://www.gesundheitsamt.de/alle/gesetz/seuche/bsg/index.htm
    'Bundes-Seuchengesetz' => 1,
    'Schwerbehindertengesetz' => 1, # http://www.schwerbehindertengesetz.de/
    'Hochschulleitungs-Stellenzulagenverordnung' => 1, # http://www.google.com/url?sa=t&rct=j&q=hstzulv%20au%C3%9Fer%20kraft%20getreten&source=web&cd=3&ved=0CFEQFjAC&url=http%3A%2F%2Fwww.gew-sachsen.de%2Fdownload%2F121%2F0%2FHochschulpolitik-in-Sachsen---quo-vadis.html&ei=wdQCULeFMs3bsgaKptmxBg&usg=AFQjCNGkcA5Ldh9ba8jR3RZ6rvkAf4CnZQ&cad=rja
    'Reichsknappschaftsgesetz' => 1, # http://www.economia48.com/deu/d/reichsknappschaftsgesetz-rkg/reichsknappschaftsgesetz-rkg.htm
    'Angestelltenversicherungsgesetz' => 1, # http://de.wikipedia.org/wiki/Angestelltenversicherungsgesetz
    'Angestelltenversicherungs-Neuregelungsgesetz' => 1, # AnVG
    'Altsparergesetz' => 1, # http://www.buzer.de/gesetz/939/index.htm
    'Holzabsatzfondsgesetz' => 1, # http://www.buzer.de/gesetz/184/index.htm
    'Absatzfondsgesetz' => 1, # http://www.buzer.de/gesetz/3191/index.htm
    'Geräte- und Produktsicherheitsgesetz' => 1, # http://dejure.org/gesetze/GPSG
    'Zweites Wohnungsbaugesetz' => 1, # http://www.bundesrecht24.de/cgi-bin/lexsoft/bundesrecht24.cgi?chosenIndex=0708&source=link&highlighting=off&xid=139813,1  Außer Kraft am 1. Januar 2002 durch Artikel 2 des Gesetzes vom 13. September 2001 (BGBl. I S. 2376)
  );
}

sub initLawNameExpansion {
  return (
    'Binnenschifffahrtsgesetz' => 'BinSchG',
    'Apothekerordnung' => 'BApO',
    'Aussensteuergesetz' => 'AStG',
    'Bundeskriminalamtgesetz' => 'BKAG',
    'Erbschaftssteuergesetz' => 'ErbStG',
    'Erbschaftsteuergesetz' => 'ErbStG',
    'Ausländerzentralregistergesetz' => 'AZRG',
    'Bundeselterngeldgesetz' => 'BEEG',
    'Verbraucherschutzdurchsetzungsgesetz' => 'VSchDG',
    'Kraft-Wärme-Koppelungsgesetz' => 'KWKG 2002',
    'Verwaltungsvollstreckungsgesetz' => 'VwVG',
    'Montan-Mitbestimmungsgesetz' => 'MontanMitbestG',
    'EG-Rechts-Überleitungsverordnung' => 'EGRechtÜblV',
    'Einigungsvertragsgesetz' => 'EinigVtrG',
    'SE-Ausführungsgesetz' => 'SEAG',
    'SCE-Ausführungsgesetz' => 'SCEAG',
    'Alkopopsteuergesetz' => 'AlkopopStG',
    'Sprecherausschussgesetz' => 'SprAuG',
    'Binnenschifffahrtsaufgabengesetz' => 'BinSchAufgG',
  );
}

# TODO: "im Sinne der $someLaw" als Referenz checken
# TODO: Verordnungen etc. zum XYZ-Gesetz sauber auflösen