#!/usr/bin/perl -w
# file KLEIDER/web/src/kalender/monidfix.pl
# Kennungen der Monatsnamen in den Kalendern korrigieren
# 2020-09-30 Herbert Schiemann <h.schiemann@herbaer.de>

use utf8;                     # Dieser Quelltext ist utf-8-kodiert
use Cwd qw(realpath);
use English;
use File::Spec::Functions qw(catdir catfile);
use File::Path qw(make_path);
use Herbaer::Readargs;
use Herbaer::Replace;

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

my $args = {
   "[cnt]verbose" => 1,
   "docroot"      => undef,                              # lokale DOCUMENT_ROOT
   "oldidsrc"     => "\${docroot}/kal/b/2020/de.xml.",   # Quelle der alten IDs
   "newidsrc"     => "\${docroot}/local/local.xml.de.",  # Quelle der neuen IDs
   "indir"        => "\${docroot}/kal/b",                # Eingabeverzeichnis
   "outdir"       => "\${docroot}/kal/bnew"              # Ausgabeverzeichnis
};

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
monidfix.pl
Kennungen der Monatsnamen in den Kalendern korrigieren
2020-09-30 Herbert Schiemann <h.schiemann@herbaer.de>
GPL 2 oder neuer
VERSION
};
$args -> {"[sr]version"} = sub { version (); exit 0; };

$args -> {"[sr]help"} = sub {
   set_defaults ($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        erhöht den Umfang der STDERR-Ausgabe \${[cnt]verbose}
--docroot  DOCROOT    Pfad der lokalen DOCUMENT_ROOT
                      \${docroot}
--oldidsrc OLDIDSRC   Quelle der alten IDs mit Platzhalter <docroot>
                      \${oldidsrc}
--indir    INDIR      Eingabeverzeichnis
                      \${indir}
--outdir   OUTDIR     Ausgabeverzeichnis
                      \${outdir}
HELP
   exit 0;
}; # help

sub set_defaults {
   my $args = shift;
   my $b = realpath ($0);
   $b =~ s/\/src\/[^\/]*\/monidfix.pl//;
   $args -> {"docroot"}  ||= "$b/docroot";
   replace ($args, $args);
}; # set_defaults

my $data = {
   "names"  => [
      "Januar",
      "Februar",
      "März",
      "April",
      "Mai",
      "Juni",
      "Juli",
      "August",
      "September",
      "Oktober",
      "November",
      "Dezember",
      ],
   "oldids" => [],  # Liste der alten Kennungen 0 - 13
   "newids" => [],  # neue Kennungen   
};

sub get_oldids {
   my ($args, $data) = @_;
   my $oldids = [];
   $data -> {"oldids"} = $oldids;
   my $fn   = $args -> {"oldidsrc"};
   my $verb = $args -> {"[cnt]verbose"};
   my $h;
   my $d;
   if (!open ($h, "<:encoding(utf-8)", $fn)) {
      print STDERR "Kann Datei \"$fn\" nicht öffnen\n";
      return;
   }
   {
      local $INPUT_RECORD_SEPARATOR;
      $d = <$h>;
      close $h;
   }
   my $pid = "";
   my $id  = "";
   # <l:ph id="en"/>
   while ( $d =~ /<l:ph id="([a-z0-9]+)"\/>/g ) {
      $id = $1;
      if ($id ne $pid) {
         push (@$oldids, $id);
         $pid = $id;
      }
   }
   if ($verb) {
      $pid = 0;
      for $id (@$oldids) {
         print "$pid $id\n";
         ++$pid;
      }
   }
}; # get_oldids


sub get_newids {
   my ($args, $data) = @_;
   my $newids = {};
   $data -> {"newids"} = $newids;
   my $fn   = $args -> {"newidsrc"};
   my $verb = $args -> {"[cnt]verbose"};
   my $h;
   my $d;
   if (!open ($h, "<:encoding(utf-8)", $fn)) {
      print STDERR "Kann Datei \"$fn\" nicht öffnen\n";
      return;
   }
   {
      local $INPUT_RECORD_SEPARATOR;
      $d = <$h>;
      close $h;
   }
   # <t id="cr">Januar</t>
   while ( $d =~ /<t id="([a-z0-9]+)">([^>]+)<\/t>/g ) {
      $newids -> {$2} = $1;
   }
   my $names = $data -> {"names"};
   if ($verb) {
      my $nm;
      my $i = 0;
      for $nm (@$names) {
         ++$i;
         print "$i $nm ", $newids -> {$nm}, "\n";
      }
   }
}; # get_newids

sub map_ids {
   my ($args, $data) = @_;
   my $oldids = $data -> {"oldids"};
   my $newids = $data -> {"newids"};
   my $idmap = {};
   $data -> {"idmap"} = $idmap;
   my $verb = $args -> {"[cnt]verbose"};
   my $names = $data -> {"names"};
   shift @$oldids;
   my $nm;
   my $id;
   while (@$names) {
      $nm = shift @$names;
      $id = shift @$oldids;
      $idmap -> {$id} = $newids -> {$nm};
   }
}; # map_ids

sub process_files {
   my ($args, $data) = @_;
   my $idmap = $data -> {"idmap"};
   my $verb  = $args -> {"[cnt]verbose"};
   my $id;
   my $subst = sub {
      $id = $idmap -> {$1} || $1;
      return "<l:ph id=\"$id\"/>";
   };
   my ($in, $out);
   my $h;
   my $d;
   my $proc_file = sub {
      ($in, $out) = @_;
      print "$in -> $out\n" if $verb;
      $h = undef;
      if (!open ($h, "<:encoding(utf-8)", $in)) {
         print STDERR "Kann Datei \"$in\" nicht öffnen\n";
         return;
      }
      {
         local $INPUT_RECORD_SEPARATOR;
         $d = <$h>;
         close $h;
      }
      $d =~ s/<l:ph id="([a-z0-9]+)"\/>/$subst -> ($idmap, $1)/ge ;
      $h = undef;
      if (!open ($h, ">:encoding(utf-8)", $out)) {
         print STDERR "Kann Ausgabedatei \"$out\" nicht öffnen\n";
         return;
      }
      print $h $d;
      close $h;
   };
   my $indir  = $args -> {"indir"};
   my $outdir = $args -> {"outdir"};
   my ($dh, $sdh);
   my ($de, $sde);
   my $dp;
   my $od;
   if (!opendir ($dh, $indir)) {
      print STDERR "Kann Verzeichnis \"$indir\" nicht lesen\n";
      return;
   }
   while (defined ($de = readdir ($dh))) {
      next unless $de =~ /^20\d\d$/;
      $dp = catdir ($indir, $de);
      next unless -d $dp;
      $sdh = undef;
      if (!opendir ($sdh, $dp)) {
         print STDERR "Kann Verzeichnis \"$dp\" nicht lesen\n";
         next;
      }
      $od = catdir ($outdir, $de);
      make_path ($od);
      while (defined ($sde = readdir ($sdh))) {
         next unless $sde =~ /\.xml(?:\..+)?\.$/;
         $proc_file -> (catfile ($dp, $sde), catfile ($od, $sde));
      }
      closedir $sdh;
   }
   closedir $dh;
}

read_args     ($args);
set_defaults  ($args);
get_oldids    ($args, $data);
get_newids    ($args, $data);
map_ids       ($args, $data);
process_files ($args, $data);

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