#!/usr/bin/perl
# Dateiindizierung im Dateisystem
use strict;
use warnings;
use Getopt::Long;

$| = 1;                   # ungepufferte Ausgabe

my $t0 = time();          # Zeitmessung
my $allterms = 0;         # Summenzaehler
my $filesizetotal = 0;    # Gesamtgroesse aller Dateien
my $config_file;          # Name der Config-Datei
my %config = ();          # Konfiguration
my @ignore_files = ();    # Liste der nicht zu indizierenden Dateien
                          # oder Verzeichnisse
my %stopwords = ();       # Stoppwortliste (Hash fuer schnelle Suche)
my %posterms =();         # Positivliste (Hash fuer schnelle Suche)

my $file_id = 0;          # Dateinummer, Feldindex von @file_list
my @file_list = ();       # Liste mit File-Ids der indizierten Dateien
                          # Array of Hashes ('size', 'name', 'title', 'desc')
my %terms = ();           # Hash of Hashes: Wort (key) und Wert ist
                          # Hash ($file_id, Worthaeufigkeit)

# Steuerdateien einlesen
GetOptions("config:s" => \$config_file);
if (-e $config_file)
  { read_config($config_file); }
else
  { die "Config-Datei nicht gefunden\n"; }
my $ignore_file     = $config{'CONFIG_DIR'} . 'ignore_files.txt';
my $pos_terms_file  = $config{'CONFIG_DIR'} . 'pos_terms.txt';
my $stopword_file   = $config{'CONFIG_DIR'} . 'stop_terms.txt';
my $database_dir    = $config{'DATABASE_DIR'};
my $csv_database    = $database_dir . 'csvdb';
my $wordlist_file   = $database_dir . 'wordlist.txt';
my @file_extensions = split(/\s+/, $config{'FILE_EXTENSIONS'});

read_ignore_files();
read_ignore_terms();
read_positive_terms() if ($config{'USE_POS_TERMS'});

print "\nIndexer-Einstellungen:\n";
print "Minimale Wortlaenge: $config{'MIN_TERM_LENGTH'}\n";
print "Laenge der Beschreibung: $config{'DESCRIPTION_LENGTH'}\n";
print "Zahlen indizieren: ", $config{'INDEX_NUMBERS'} ? "ja" : "nein", "\n";
print "Positivliste verwenden: ", $config{'USE_POS_TERMS'} ? "ja" : "nein", "\n";
print "common terms entfernen: ",$config{'REMOVE_COMMON'} ? "ja" : "nein", "\n";
print "Dateienendungen: $config{'FILE_EXTENSIONS'}\n";

# Dateien indizieren
indexer($config{'INDEXER_START'});
remove_common_terms() if$config{'REMOVE_COMMON'};

# Wortliste und Datenbanken erzeugen
create_wordlist() unless ($config{'USE_POS_TERMS'});
create_csv_database();
create_flatfile_database();

# Statistik ausgeben
print "\nEs wurden ", $allterms, ' Worte aus ', $file_id,
      ' Dateien (', $filesizetotal, 'KB) indiziert.', "\n";
my $timediff = time() - $t0;
my $seconds = $timediff % 60;
my $minutes = ($timediff - $seconds) / 60;
print "Laufzeit: $minutes Minuten und $seconds Sekunden\n";


sub indexer # ($dir)
  {
  # Dateibaum unterhalb des Startpfades durchlaufen
  my $dir = shift;
  my ($file_ref, $file);
  print "\nIndizierung beginnt bei $dir\n";
  # ins Verzeichnis wechseln
  chdir $dir or (warn "Cannot chdir $dir: $!\n" and next);
  opendir(DIR, $dir) or (warn "Cannot open $dir: $!\n" and next);
  my @dir_contents = readdir DIR;
  closedir(DIR);
  # Verzeichnisse und Dateien extrahieren
  my @dirs  = grep {-d and not /^\.{1,2}$/} @dir_contents;
  my @files = grep {-f and /^.+\.(.+)$/ and grep {/^\Q$1\E$/}
                      @file_extensions} @dir_contents;
  # Dateien indizieren
  FILE: foreach my $filename (@files)
    {
    $file = $dir."/".$filename;        # Verzeichnispfad hinzufügen
    $file =~ s|//|/|og;                # ggf. "//" --> "/" umwandeln
    foreach my $skip (@ignore_files)   # Datei in Negativliste?
      { next FILE if $file =~ m/^$skip$/; }
    # -----------------------------------------------------------
    $file_ref = make_file_ref($file);  # Dateireferenz erzeugen
    index_file($file,$file_ref);       # ind Datei indizieren
    # -----------------------------------------------------------
    }
  # Unterverzeichnisse rekursiv bearbeiten
  DIR: foreach my $dir_name (@dirs)
    {
    $file = $dir."/".$dir_name;        # Verzeichnispfad hinzufuegen
    $file =~ s|//|/|og;                # ggf. "//" --> "/" umwandeln
    foreach my $skip (@ignore_files)   # Verzeichnis in Negativliste?
      { next DIR if $file =~ /^$skip$/; }
    indexer($file);                    # rekursiver Aufruf
    }
  }


sub make_file_ref # ($file)
  {
  # Dateireferenz erzeugen
  my $file = shift;
  my $size = int((((stat($file))[7])/1024)+.5);
  # Dateigroesse in KB speichern
  $file_list[$file_id]{'size'} = $size;
  # Namen der Datei ohne Startpfad speichern
  $file =~ m/^$config{'INDEXER_START'}(.*)$/;
  $file = $1;
  $file_list[$file_id]{'name'} = $file;
  $filesizetotal += $size;             # Groesse aller Dateien
  print "   Erzeuge Index fuer $file, Groesse: $size KB\n";
  $file_id++;                          # Dateinummer inkrementieren
  return ($file_id - 1);               # akt. Dateinummer retournieren
  }


sub index_file # ($file, $file-id)
  {
  # Datei indizieren
  my ($file, $file_id) = @_;
  my ($ok, $key, $contents, $termcount);
  my %term_total;

  # Datei als einen String einlesen
  undef $/;
  open(FILE, $file) or (warn "Cannot open $file: $!" and next);
  $contents = <FILE>;
  close(FILE);
  $/ = "\n";

  # Beschreibung und Titel extrahieren
  record_description($file_id, $file, $contents);
  # Dateiinhalt von unoetigem Ballast befreien
  $contents = clean($contents);

  # Daateiinhalt in Wortliste zerlegen
  foreach (split(/\s+/, $contents))
    {
    $termcount++;                                   # Wortzaehler inkrementieren
    next if (defined($stopwords{$_}));              # Stopworte ignorieren
    if (!$config{'INDEX_NUMBERS'}) {next if m/^[0-9-]+.*$/;}  # ggf. Zahlen ignorieren
    # Falls Positivliste gewuenscht wurde
    if ($config{'USE_POS_TERMS'})
      {
      $ok = 0;
      $ok = 1 if (defined($posterms{$_}));          # Wort in Positivliste
      unless ($ok)
        {
        foreach $key (keys %posterms)               # Nachsehen, ob Wort ein
          {                                         # Teilstring eines Wortes
          if ($_ =~ m/^$key/i)                      # der Positivliste ist
            { $_ = $key; $ok = 1; next; }
          }
        }
      next unless ($ok);                            # auch nicht ...
      }
    # Wort eintragen, sofern nicht zu kurz oder zu lang
    if (length $_ >= $config{'MIN_TERM_LENGTH'} && length $_ <= $config{'MAX_TERM_LENGTH'})
      { $term_total{$_}++; }                        # Wort ist Key, Anzahl ist Wert
    }
  # Hash of Hash: Key ist Wort, Value ist Hash $file_id => Anzahl
  foreach (keys %term_total)
    { $terms{$_}{$file_id} = $term_total{$_};
    }
  $allterms += $termcount;                          # zaehlt alle Worte in allen Dateien
  print "   $termcount Worte im Index gespeichert.\n\n";
  }


sub clean
  { # Text "saeubern"
  my $contents = shift;
  # in Kleinbuchstaben umwandeln
  $contents = lc($contents);
  $contents =~ s/&auml;/ä/gs;     # HTML uebersetzen
  $contents =~ s/&ouml;/ö/gs;
  $contents =~ s/&uuml;/ü/gs;
  $contents =~ s/Ä/ä/gs;          # Ä,Ö,Ü wird von lc() nicht behandelt
  $contents =~ s/Ö/ö/gs;
  $contents =~ s/Ü/ü/gs;
  $contents =~ s/ß/ss/gs;
  $contents =~ s/&quot;//gs;      # Gänsefuesschen weg
  $contents =~ s/\"//gs;
  # Scripts and Styles loeschen
  $contents =~ s/(<script[^>]*>.*?<\/script>)|(<style[^>]*>.*?<\/style>)/ /gsi;
  # HTML-Tags entfernen
  $contents =~ s/(<[^>]*>)|(&[^\s]+;)/ /gs;
  # unerwuenschte Zeichen entfernen
  $contents =~ tr/a-zäöüß0-9\-\$\%\&/ /cs;
  # '-' am Wortende entfernen
  $contents =~ s/-$//;
  return $contents;
  }


sub record_description # ($file_ref, $file, $contents)
  {
  # Datensatzbeschreibung und Titel extrahieren
  my ($file_ref, $file, $contents) = @_;
  my ($description, $title, $pos);
  # zuerst ein "kleines" clean ausfuehren
  $contents =~ s/&auml;/ä/gs;
  $contents =~ s/&ouml;/ö/gs;
  $contents =~ s/&uuml;/ü/gs;
  $contents =~ s/&Auml;/Ä/gs;
  $contents =~ s/&Ouml;/Ö/gs;
  $contents =~ s/&Uuml;/Ü/gs;
  $contents =~ s/&szlig;/ß/gs;
  $contents =~ s/&quot;//gs;
  # Scripts and Styles loeschen
  $contents =~ s/(<script[^>]*>.*?<\/script>)|(<style[^>]*>.*?<\/style>)/ /gsi;
  # Datensatzbeschreibung extrahieren
  # Meta-Tags verwenden - suchen nach <meta name="description" content="...">
  $contents =~ m/<meta\s+name\s*=\s*[\"\']?description[\"\']?\s+content=[\"\']?(.*?)[\"\']?>/is;
  $description = $1;
  # falls kein Meta-Tag, Inhalt probieren
  unless ($description && $description !~ /^\s*$/)
    {
    # nur den BODY beachten
    $contents =~ m/<BODY.*?>(.*)<\/BODY>/si;
    $description = $1;
    # kein <BODY>-Tag? seltsam ...
    $description = $contents unless $description;
    # HTML-Tags entfernen
    $description =~ s/(<[^>]*>)|(&[^\s]+;)/ /gs;
    }
  # unerwuenschte Zeichen entfernen
  $description =~ tr/A-Za-zäöüÄÖÜß0-9'\.,\-\$\%/ /cs;
  # mehrfache Leerzeichen entfernen
  $description =~ s/\s+/ /gs;
  $description =~ s/\"//g;
  $pos = rindex($description, ' ', $config{'DESCRIPTION_LENGTH'});
  $description = substr($description, 0, $pos) . " ... ";
  # und im Datensatz-Array speichern
  $file_list[$file_ref]{'desc'} = $description;
  # nun den Titel herausholen
  $contents =~ m/<TITLE>\s*(.*?)\s*<\/TITLE>/is;
  $title = $1;
  if($title)
    {
    # HTML-Tags entfernen
    $title =~ s/(<[^>]*>)|(&[^\s]+;)/ /gs;
    $file =~ s/^.*\/([^\/]+)$/$1/g;
    $title =~ s/\"//g;
    }
  else
    {
    # Falls kein Titel da ist, Dateinamen verwenden
    $title = $file;
    }
  # und im Titelarray speichern
  $file_list[$file_ref]{'title'} = $title;
  print "   Titel: $title\n";
  }


sub remove_common_terms
  {
  # zu haeufige Worte aus der Wortliste entfernen
  print "Entferne zu haeufige Worte\n";
  my @common_terms;
  my ($term, $val);
  while (($term,$val) = each %terms)
    {
	  my %p = %{$terms{$term}};
	  if (scalar(keys %p) > ($config{'REMOVE_COMMON'}/100 * $file_id))
	    {	push @common_terms, $term; }
	  }
  if (@common_terms)
    {
    print 'Folgende Worte tauchen in mehr als ',$config{'REMOVE_COMMON'},
          '% aller Dateien auf:', "\n";
    foreach $term (@common_terms)
      {
      delete ($terms{$term});	# common terms entfernen
      print "$term\n";
      }
    }
  else
    { print 'Keine "common terms" gefunden', "\n"; }
  }


sub read_config
  {
  my $file   = shift;             # Dateinamen holen
  my $count  = 0;                 # Zeilenzähler
  my $group  = '';                # Gruppenbezeichner
  my ($line, $key, $value);       # Arbeitsvariablen

  open(CF,"<", $file) or die "Oops! $file: $!";
  while ($line = <CF>)
   {
   $count++;
   chomp($line);                  # Newline weg
   next if($line =~ m/^\s*#/);    # Kommentarzeile ignorieren
   next if $line =~ m/^\s*$/;     # Leerzeilen ignorieren
   if ($line !~ m/^\s*\S+\s*=.*$/) # sieht nicht nach "Key = Value" aus?
     {
     warn "*** moeglicher Fehler in Zeile $count; von $file\n";
     next;
     }
   # Zeile zerlegen, alles hinter dem "=" kommt nach $value
   ($key,$value) = split(/=/, $line, 2);
   # Blanks rund um den Key entfernen
   $key   =~ s/^\s+//g;
   $key   =~ s/\s+$//g;
    # End-Kommentare in $value entfernen
   $value =~ s/#.*$//;
   # Blanks rund um $value entfernen
   $value =~ s/^\s+//g;
   $value =~ s/\s+$//g;
   # Anfuehrungszeichen bei $value entfernen
   $value =~ s/^['"]//g;
   $value =~ s/['"]$//g;
   # Daten in den Hash aufnehmen
   $config{$key} = $value;
   }
  close(CF);
  }


sub read_ignore_files
  {
  # lese Negativ-Dateiliste ein
  my $count = 0;

  unless (-e $ignore_file)
    {
    # keine Dateiliste, fertig
    print STDERR "Warnung: Datei $ignore_file nicht gefunden.\n";
    return;
    }
  # Dateien einlesen
  print "Lade Negativliste (auszuschliessende Dateien):\n";
  open (FILE, $ignore_file) or die "Cannot open $ignore_file: $!\n";
  while (<FILE>)
    {
    $count++;
    chomp;
    $_ =~ s/\r//g;           # CR weg (DOS/Windows)
    $_ =~ s/\#.*$//g;        # Kommentare ignorieren
    $_ =~ s/[\/\s]*$//;      # / und Leerzeichen am Ende weg
    next if /^\s*$/;         # Leerzeile
    print "$_\n";            # Protokoll
    push @ignore_files, $_;
    }
  close (FILE);
  print "$count Dateien/Verzeichnisse gelesen.\n";
  }


sub read_ignore_terms
  {
  # Stoppwortliste einlesen
  my $count = 0;
  unless (-e $stopword_file)
    {
    # keine Datei, fertig
    print STDERR "Warnung: Datei $stopword_file nicht gefunden.\n";
    return;
    }
  print "Verwende Stoppwortliste: $stopword_file\n";
  open (FILE, $stopword_file) or die "Cannot open $stopword_file: $!";
  while (<FILE>)
    {
    chomp;
    $_ =~ s/\r//g;           # CR weg (DOS/Windows)
    $_ =~ s/\#.*$//g;        # Kommentare ignorieren
    $_ =~ s/\s//g;           # Leerzeichen entfernen
    next if /^\s*$/;         # Leerzeile
    $count++;                # Stoppwort speichern
    $stopwords{$_} = $count;
    }
  close(FILE);
  print "$count Stopworte gelesen.\n\n";
  }


sub read_positive_terms
  {
  # Positivwortliste einlesen
  my $count = 0;
  unless (-e $pos_terms_file)
    {
    # keine Datei, fertig
    print STDERR "Warnung: Datei $pos_terms_file nicht gefunden.\n";
    return;
    }
  print "Verwende Positivliste: $pos_terms_file\n";
  open (FILE, $pos_terms_file) or die "Cannot open $pos_terms_file: $!";
  while (<FILE>)
    {
    chomp;
    $_ =~ s/\r//g;        # CR weg (DOS/Windows)
    $_ =~ s/\#.*$//g;     # Kommentare ignorieren
    $_ =~ s/\s//g;        # Leerzeichen entfernen
    next if /^\s*$/;      # Leerzeile
    $count++;             # Positivterm speichern
    $posterms{$_} = $count;
    }
  close(FILE);
  print "$count Positivworte gelesen.\n\n";
  }


sub create_wordlist
  {
  # Komplette Wortliste erzeugen
  print "\nGeneriere Wortliste $wordlist_file\n";
  open(NEWFILE, ">", $wordlist_file) or die "Can't open $wordlist_file: $!\n";
  foreach my $term (sort(keys %terms))
    {
    $term = '#' . $term if ($term =~ /^[0-9]+$/); # numerisch
    print NEWFILE "$term\n";
    }
  close (NEWFILE);
  }


sub create_flatfile_database
  {
  # Zweistufigen Wortindex erzeugen
  my $filen;         # aktueller Dateiname ("A.html" bis "Z.html"
  my $first = ' ';   # aktueller Anfangsbuchstabe
  my $char  = ' ';

  print "Generiere Wortindizes\n";
  mkdir ($database_dir,0755) unless (-d $database_dir);
  # INDEXFILE enthaelt die Wortliste mit Links aus A.html - Z.html
  open(INDEXFILE, ">", $database_dir."search.html") or
          die "Can't open search.html: $!\n";
  # HTML-Vorspann erzeugen
  print INDEXFILE qq~
   <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
   <HTML>
   <HEAD>
   <META http-equiv="content-type" content="text/html;charset=iso-8859-1">
   <TITLE>Suchwortkatalog</TITLE>
   <link rel="stylesheet" href="/text.css">
   </HEAD>
   <BODY bgcolor="#ffffff" text="#000000" link="#007800" alink="#003300" vlink="#663366">
   <H1>Suchwortkatalog</H1>
  ~;
  # Dateien erstellen, Schleife ueber alle Worte (sortiert)
  foreach my $term (sort(keys %terms))
    {
    # Verweisliste auf alle Fundstellen zum Wort holen
    my %p = %{$terms{$term}};
    # Neuer Anfangsbuchstabe? Dann muss die alte Datei (A.html - Z.html)
    # geschlossen und eine neue mit dem Folgebuchstaben geoeffnet werden
    if ($term =~ /^[A-Za-z0-9]+$/)
      {
      $term =~ s/\"//g;
      $char = uc(substr($term,0,1));
      if ($char ne $first)
        {
        $first = $char;
        if ($first =~ /^[B-Z]/)
          {
          # alte Datei schliessen
          print NEWFILE qq~
           <DIV ALIGN="CENTER">
           <A HREF="javascript:history.back()"><B>[ Zur&uuml;ck ]</B></A>
           </DIV>
           </BODY>
           </HTML>
          ~;
          close(NEWFILE);
          # beim Wortindex Wortliste schliessen
          print INDEXFILE "\n</ul>\n";
          }
        # Bei Wortindex neue Wortliste beginnen
        print INDEXFILE "\n\n", '<a name="', $first, '"><H2>', $first, "</H2></a>\n<ul>\n";
        # Neue Datei  (A.html - Z.html) oeffnen
        $filen = $first.'.html';
        print "Writing: $database_dir$filen\n";
        open(NEWFILE, ">", $database_dir.$filen) or die "Can't open $filen: $!\n";
        # HTML-Vorspann schreiben
        print NEWFILE qq~
         <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
         <HTML>
         <HEAD>
         <META http-equiv="content-type" content="text/html;charset=iso-8859-1">
         <TITLE>Wortindex f&uuml;r [ $first ]</TITLE>
         <link rel="stylesheet" href="/text.css">
         </HEAD>
         <BODY bgcolor="#ffffff" text="#000000" link="#007800" alink="#003300" vlink="#663366">
         <H1>$first</H1>
        ~;
        }
      # jedes neue Wort wird als Ueberschrift ausgegeben
      print NEWFILE '<a name="', $term, '"><H3>', $term, "</H3></a>\n<dl>\n";
      # Danach folgt eine Liste der Fundstellen als "definition list"
      while (my ($key, $val) = each %p)
        {
        print NEWFILE '<dt><a href="', $config{'TARGET_DIR'}, $file_list[$key]{'name'},
                      '" target="_blank">', $file_list[$key]{'title'}, "</a>\n",
                      '<dd>' . $file_list[$key]{'desc'},
                      '\n<br><font size="1"><B>', $val, ' Fundstelle(n), ',
                      'Grösse: ', $file_list[$key]{'size'},
                      " KB </B></font></dd></dt>\n\n";
        }
      print NEWFILE "</dl>\n";
      # Wortindex ergaenzen
      print INDEXFILE '<li><a href="'.$filen.'#'.$term.'">'.$term."</a>\n";
      }
    }
  # Datei Z.html schliessen
  print NEWFILE qq~
   <DIV ALIGN="CENTER">
   <A HREF="javascript:history.back()"><B>[ Zur&uuml;ck ]</B></A>
   </DIV>
   </BODY></HTML>
   ~;
  close (NEWFILE);
  # Wortindex schliessen
  print INDEXFILE "</ul>\n</BODY>\n</HTML>\n";
  close(INDEXFILE);
  }


sub create_csv_database
  {
  # Dump der Daten als CSV-Dateien
  my @terms;
  print "Generiere csv-Datenbanken\n";
  open(NEWFILE, ">", $csv_database."-file.csv") or
          die "Can't open $csv_database-file.csv: $!\n";
  # Zeilen:    "Id","Name","Titel","Beschreibung","Groesse"
  for my $file_id (0 .. $#file_list)
    {
    print NEWFILE '"' . $file_id .
                  '","' . $file_list[$file_id]{'name'} .
                  '","' . $file_list[$file_id]{'title'} .
                  '","' . $file_list[$file_id]{'desc'} .
                  '","' . $file_list[$file_id]{'size'} .
                  "\"\n";
	  }
  close (NEWFILE);

  open(NEWFILE, ">", $csv_database."-word.csv") or
         die "Can't open $csv_database-word.csv: $!\n";
  # Zeilen:   "Wort","Id=Anzahl|Id=Anzahl|..."
  @terms = sort(keys %terms);
  foreach my $term (@terms)
    {
    my $filelist;
    my %p = %{$terms{$term}};
    $term = '#' . $term if ($term =~ /^[0-9]+$/);
    print NEWFILE '"' . $term . '","';
    while (my ($key, $val) = each %p)
      { $filelist .= $key . '=' . $val . '|'; }
	  print NEWFILE $filelist . "\"\n";
    }
  close (NEWFILE);
  }