#!/usr/bin/perl -w
# file KLEIDER/web/src/kalender/tree.pl
# Baumstruktur der Kalender
# 2015-12-22 Herbert Schiemann <h.schiemann@herbaer.de>
# 2020-04-12 Voreinstellung webdir

use utf8 ;               # Dieser Quelltext ist utf-8-kodiert
use Cwd qw(realpath);
use File::Spec::Functions;
use Herbaer::Readargs;   # read_args ()
use Herbaer::Replace;    # replace ()
use Herbaer::XMLDataWriter ;
# use POSIX;

binmode (STDERR, ":encoding(utf-8)");
binmode (STDOUT, ":encoding(utf-8)");

my $args = {
   "[cnt]verbose" => 1,
   "lang"         => "de",                        # Sprache
   "webdir"       => undef,                       # Website-Basisverzeichnis
   "kaldir"       => '${webdir}/kalender',        # Verzeichnis der Kalender-Quellen
   "srcdir"       => '${webdir}/src/kalender',    # Verzeichnis der Skripte
   "shiftnd"      => [],                          # Namen "geschobener"  Knoten
   "incldir"      => [],                          # Regex eingeschlosser Verzeichnisse
   "excldir"      => [],                          # Regex ausgenommener Verzeichnisse
   "inclfile"     => [],                          # Regex eingeschlossener Dateien
   "exclfile"     => [],                          # Regex ausgenommener Dateien
   "rtname"       => undef,                       # Name des Wurzelknotens
   "rtrefbase"    => "kal",                       # Verweis-Basis des Wurzelknotens
   "rttitle"      => undef,                       # Titel des Wurzelknotens
   "ixfile"       => "index.xhtml",               # Default-Index-Datei
   "dirnmflt"     => [],                          # Namensfilter für Verzeichnisse
   "filenmflt"    => [],                          # Namensfilter für Dateien

   # Befehl zur Bestimmung des Titels mit Platzhaltern
   "titlecmd"     => "\${srcdir}/titlecmd \${file} \${lang}",

   # XML-Namensraum der Ausgabe
   "xmlns"        => "http://herbaer.de/xmlns/20151222/tree/",
};

my $data = {};

sub set_default {
   my $args = shift;
   if (! $args -> {"webdir"}) {
      my $b = realpath ($0);
      $b =~ s/\/src\/kalender\/tree\.pl//;
      $args -> {"webdir"} = $b;
   }   
   my $k;
   for $k ("kaldir", "srcdir", "titlecmd") {
      $args -> {$k} = replace ($args -> {$k}, $args);
   }
   if (! @{$args -> {"shiftnd"}} ) {
      my $lt = [localtime()];
      my $m = $lt -> [4];
      my $y = $lt -> [5] + 1900;
      ++$y if $m == 11;
      $args -> {"shiftnd"} = [ "$y", ];
   }
   @{$args -> {"incldir"}}   or $args -> {"incldir"}   = ['/2\d{3}$',];
   @{$args -> {"excldir"}}   or $args -> {"excldir"}   = ['/feiertage$',];
   @{$args -> {"inclfile"}}  or $args -> {"inclfile"}  = ['\.xml\.?$',];
   @{$args -> {"exclfile"}}  or $args -> {"exclfile"}  = ['/tree\.xml$',];
   @{$args -> {"dirnmflt"}}  or $args -> {"dirnmflt"}  = ['^(?:.*/)*([^.]+)',];
   @{$args -> {"filenmflt"}} or $args -> {"filenmflt"} = ['^(?:.*/)*([^.]+)',];

   my $re;  # regular expression
   my $rel; # regular expression list
   if (! $args -> {"rtname"}) {
      $args -> {"rtname"} = "kalender";
      $rel = [ map { qr/$_/ } @{$args -> {"dirnmflt"}} ];
      for $re (@$rel) {
         if ( $args -> {"kaldir"} =~ $re ) { $args -> {"rtname"} = $1; last; }
      }
   }
   my $pth;   # Dateipfad
   my $cd;    # Befehl zum Ermitteln des Titels
   my $ch;    # Handle zum Lesen des Titels (Befehls-Ausgabe)
   if (! $args -> {"rttitle"}) {
      $pth = catfile ($args -> {"kaldir"}, $args -> {"ixfile"});
      $pth .= ".de" unless -f $pth;
      if ( -f $pth ) {
         $cd = replace ($args -> {"titlecmd"}, { "file" => $pth, });
         $ch = undef;
         open ($ch, "$cd |") or do {
            print STDERR "Kann Befehl $cd nicht ausführen $!\n";
            exit;
         };
         binmode ($ch, ":encoding(utf-8)");
         $args -> {"rttitle"} = <$ch>;
         close ($ch);
      }
   }
   $args -> {"rttitle"} or $args -> {"rttitle"} = "Kalender";
} # set_default

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
KLEIDER/web/src/kalender/tree.pl
Baumstruktur der Kalender
2015-12-22
2015 - 2020 Herbert Schiemann <h.schiemann@herbaer.de>
VERSION
};
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   set_default ($args);
   version ();
   print_message_with_values (<<"HELP", $args);
$0 --help     zeigt diese Hilfe an
$0 --version  zeigt die Programm-Version an

$0 [option]...
--[no_]verbose            Mehr Meldungen nach STDERR \${[cnt]verbose}
--lang       LANG         Kennung der Sprache \${lang}
--webdir     WEBDIR       Basisverzeichnis zur Website
                          \${webdir}
--kaldir     KALDIR       Verzeichnis der Kalender-Quellen
                          \${kaldir}
--shiftnd    SHIFTND ..   Verschobene Knoten \${shiftnd}
--incldir    INCLDIR ..   Regex der eingeschlossenen Verzeichnisse \${incldir}
--excldir    EXCLDIR ..   Regex der ausgenommenen Verzeichnisse \${excldir}
--inclfile   INCLFILE ..  Regex der eingeschlossenen Dateien \${inclfile}
--exclfile   EXCLFILE ..  Regex der ausgenommenen Dateien \${exclfile}
--rtname     RTNAME       Name des Wurzelknotens \${rtname}
--rtrefbase  RTREFBASE    Verweis-Basis des Wurzelknotens \${rtrefbase}
--rttitle    RTTITLE      Titel des Wurzelknotens \${rttitle}
--ixfile     IXFILE       Default-Index-Datei \${ixfile}
--dirnmflt   DIRNMFLT ..  Namensfilter für Verzeichnisse \${dirnmflt}
--filenmflt  FILENMFLT .. Namensfilter für Dateien \${filenmflt}
--titlecmd   TITLECMD     Befehl zur Bestimmung der Titels mit Platzhaltern
                          \${titlecmd}
--xmlns      XMLNS        XML-Namensraum der Ausgabe
                          \${xmlns}
HELP
   exit 0;
}; # help

read_args   ($args);
set_default ($args);

collect_data ($args, $data);
add_shiftnd  ($args, $data);
print_data   ($args, $data);

sub collect_data {
   my ($args, $data) = @_;
   my $node  = {
      "name"     => $args -> {"rtname"},
      "refbase"  => $args -> {"rtrefbase"},
      "title"    => $args -> {"rttitle"},
      "ref"      => $args -> {"ixfile"},
      "node"     => [],
   } ;
   $data -> {"node"} = [$node];
   $args -> {"rid"} = [ map { qr/$_/ } @{$args -> {"incldir"}}   ];
   $args -> {"red"} = [ map { qr/$_/ } @{$args -> {"excldir"}}   ];
   $args -> {"rif"} = [ map { qr/$_/ } @{$args -> {"inclfile"}}  ];
   $args -> {"ref"} = [ map { qr/$_/ } @{$args -> {"exclfile"}}  ];
   $args -> {"dnf"} = [ map { qr/$_/ } @{$args -> {"dirnmflt"}}  ];
   $args -> {"fnf"} = [ map { qr/$_/ } @{$args -> {"filenmflt"}} ];
   process_dir ($args, $args -> {"kaldir"}, $node -> {"node"});
} # collect_data

# Die Daten eines Verzeichnisses "einsammeln"
sub process_dir {
   my ($args, $dir, $nodes) = @_;
   my $dh;   # Verzeichnis-Handle
   my $de;   # Verzeichniseintrag
   my $path; # Dateipfad
   my $verb = $args -> {"[cnt]verbose"};
   opendir ($dh, $dir) or do {
      print STDERR "Kann Verzeichnis $dir nicht öffnen: $!\n" if $verb;
      return;
   };
   my $re;      # ein regulärer Ausdruck
   my $n;       # ein Zähler
   my $rid = $args -> {"rid"};
   my $red = $args -> {"red"};
   my $rif = $args -> {"rif"};
   my $ref = $args -> {"ref"};
   my $dnf = $args -> {"dnf"};
   my $fnf = $args -> {"fnf"};
   my $cmd = $args -> {"titlecmd"};
   my $pth;      # Dateipfad einer Index-Quelldatei
   my $cd;       # Befehl nach der Ersetzung der Platzhalter
   my $ch;       # Handle zum Lesen der Ausgabe des Befehls

   # Knotendaten
   my $node;     # ein Knoten
   my $name;     # Name
   my $refbase;  # Verweis-Basis
   my $title;    # Titel
   my $link;     # Verweis
   my $repl = { "file" => undef, }; # Werte der Platzhalter in titlecmd

   while (defined ($de = readdir ($dh))) {
      next if $de eq "." || $de eq ".." ;
      $path = catfile ($dir, $de);
      if (-f $path) {
         $n = 0;
         for $re (@$rif) {
            if ( $path =~ $re ) { ++$n; last; }
         }
         next unless $n;
         $n = 0;
         for $re (@$ref) {
            if ( $path =~ $re ) { ++$n; last; }
         }
         next if $n;
         print STDERR "file $path\n" if $verb;
         $name = $de;
         for $re (@$fnf) {
            if ( $path =~ $re ) { $name = $1; last; }
         }
         $de =~ s/\.$//;
         $node = {
            "ref"  => $de,
            "name" => $name,
         };
         push (@$nodes, $node);
         $repl -> {"file"} = $path;
         $cd = replace ($cmd, $repl);
         $ch = undef;
         open ($ch, "$cd |") or do {
            print STDERR "Kann Befehl $cd nicht ausführen $!\n";
            exit;
         };
         binmode ($ch, ":encoding(utf-8)");
         $title = <$ch>;
         close ($ch);
         $node -> {"title"} = $title if $title;
      }
      elsif (-d $path) {
         $n = 0;
         for $re (@$rid) {
            if ( $path =~ $re ) { ++$n; last; }
         }
         next unless $n;
         $n = 0;
         for $re (@$red) {
            if ( $path =~ $re ) { ++$n; last; }
         }
         next if $n;
         print STDERR "dir $path\n" if $verb;
         $name = $de;
         for $re (@$dnf) {
            if ( $path =~ $re ) { $name = $1; last; }
         }
         $node = {
            "refbase" => $de,
            "name"    => $name,
            "ref"     => $args -> {"ixfile"},
            "node"    => [],
         };
         $pth = catfile ($path, $args -> {"ixfile"});
         $pth .= ".de" unless -f $pth;
         if ( -f $pth ) {
            $cd = replace ($args -> {"titlecmd"}, { "file" => $pth, });
            $ch = undef;
            open ($ch, "$cd |") or do {
               print STDERR "Kann Befehl $cd nicht ausführen $!\n";
               exit;
            };
            binmode ($ch, ":encoding(utf-8)");
            $node -> {"title"} = <$ch>;
            close ($ch);
         }
         $node -> {"title"} ||= $name;
         push (@$nodes, $node);
         process_dir ($args, $path, $node -> {"node"});
      }
   }
   closedir ($dh);
} # process_dir

# Den Inhalt der "Schiebeknoten" oben in der Baumansicht hinzufügen
sub add_shiftnd {
   my ($args, $data) = @_;
   my $nodes = $data -> {"node"} -> [0] -> {"node"};
   return unless $nodes;
   my $sn = {};
   my $nm;
   for $nm (@{$args -> {"shiftnd"}}) {
      ++$sn -> {$nm};
   }
   my $nn = [];     # neue Knoten
   my $n;           # ein Knoten
   my $c;           # Kindknoten
   my $nl;          # Knotenliste
   my $prf;         # Verweis-Präfix
   my $cc;          # neuer Knoten
   for $n (@$nodes) {
      if ($sn -> {$n -> {"name"}}) {
         $nl = $n -> {"node"} or next;
         $prf = $n -> {"refbase"} || "";
         $prf .= "/" if $prf;
         for $c (@$nl) {
            $cc = {
               "name"  => $c -> {"name"},
               "title" => $c -> {"title"},
               "ref"   => $prf . $c -> {"ref"}
            };
            $cc -> {"refbase"} = $prf . $c -> {"refbase"} if $c -> {"refbase"};
            $cc -> {"node"}    = $c -> {"node"}           if $c -> {"node"};
            push (@$nn, $cc);
         }
      }
   }
   unshift (@$nodes, @$nn);
} # add_shiftnd

sub print_data {
   my ($args, $data) = @_;
   my $opt = {};
   my $writer = Herbaer::XMLDataWriter -> new ($opt);
   $writer -> open ("-", "utf-8", $args -> {"xmlns"}, "");
   $writer -> write ("tree", {}, $data);
   $writer -> close ();
} # print_data

# end of file KLEIDER/web/src/kalender/tree.pl