#!/usr/bin/perl -w
# file KLEIDER/web/src/kalender/base.pl
# Basis-Kalenderdaten
# 2015-12-16 Herbert Schiemann <h.schiemann@herbaer.de>

# 2016-11-01 Voreinstellung --year
# 2016-11-23 Voreinstellung --monmode i
# 2016-12-07 --lang: mehrere Sprachen mit mehreren Ausgabedateien
# 2017-05-25 --country statt --lang, Voreinstellung --out
# 2017-05-29 --ft: Feiertage aus Textdatei
# 2017-05-31 Jahr aus FT lesen
# 2020-04-12 Voreinstellung --out

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 POSIX;

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

my $args = {
   "[cnt]verbose" => 1,
   "country"      => [],     # Ländercodes
   "out"         => undef,   # Ausgabedatei mit Platzhaltern
   "year"        => undef,
   "f"           => [],      # vorgegebene Feiertage
   "w"           => [],      # weitere Feiertage
   "ft"          => undef,   # Feiertage aus Textdatei
   "mode"        => [],      # Liste der Tabellenformate
   "monmode"     => "i",     # de:  deutsche Monatsnamen
                             # num: Zahlen
                             # i:   Platzhalter
   "[cnt]wd"     => undef,   # alle Wochentage ausgeben
   "[cnt]moncol" => 1,       # Spalte für Monatsnamen
   "[cnt]weekno" => 1,       # Wochenzahlen ausgeben
};

my $data = {
   "monate" => [
      # 0  Monatsname,
      # 1  Zahl der Tage des Monats
      # 2  Lfd. Nummer des 1. Tages ab 1. Januar (1),
      # 3  Wochentag des Monatsersten von 1 (Mo) bis 7 (So)
      ["Dezember",  31, 1, 1],
      ["Januar",    31, 1, 1],
      ["Februar",   28, 1, 1],
      ["März",      31, 1, 1],
      ["April",     30, 1, 1],
      ["Mai",       31, 1, 1],
      ["Juni",      30, 1, 1],
      ["Juli",      31, 1, 1],
      ["August",    31, 1, 1],
      ["September", 30, 1, 1],
      ["Oktober",   31, 1, 1],
      ["November",  30, 1, 1],
      ["Dezember",  31, 1, 1],
      ["Januar",    31, 1, 1],
      ],
   # Wochentag des 1. Januar, 1 Montag, 7 Sonntag
   "wotagstart" => undef,
   # Anzahl der Kalenderwochen
   "aw"         => undef,
   # Anzahl der Kalenderwochen des Vorjahres
   "awv"        => undef,
   # Hash der Feiertage: Schlüssel: Datums-Zeichenkette dd-mm
   "f"          => undef,
};

sub set_default {
   my $args = shift;
   my $verb = $args -> {"[cnt]verbose"};
   if (! $args -> {"out"}) {
      my $b = realpath ($0);
      $b =~ s/\/src\/kalender\/base\.pl//;
      $args -> {"out"} = "$b/kalender/base/\${year\}/\${ctry\}.xml",
   }
   # Feiertage
   my $ft = $args -> {"ft"};
   my $file_read = 0;
   if ($ft && $ft ne "none") {
      my $f = [];
      my $l;
      my $h;
      if ( $ft eq "STDIN" ) {
         $h = STDIN
      }
      elsif ($ft) {
         open ($h, "<:encoding(utf-8)", $ft) or do {
            print "Kann Datei \"$ft\" nicht lesen: $!\n" if $verb;
         };
      }
      if ($h) {
         while (defined ($l = <$h>)) {
            last if $l =~ /^\s*#END\s+Feiertage/;
            $l =~ s/#.*$//;
            $l =~ s/\s+$//;
            $l =~ s/^\s+//;
            next unless $l;
            if ( $l =~ /^\s*([01][0-9]-[0-3][0-9])$/ ) {
               push (@$f, $1);
            }
            elsif ( $l =~ /(20[0-9]{2})$/ ) {
               $args -> {"year"} = 0 + $1;
            }
         }
         $args -> {"f"} = $f;
         $args -> {"w"} = [];
         $file_read = 1;
         close $h unless $ft eq "STDIN";
      }
   }
   if (! $args -> {"year"}) {
      my $m;
      my $y;
      my $t = [localtime()];
      $m = $t -> [4];
      $y = $t -> [5] + 1900;
      $y += 1 if $m > 9;
      $args -> {"year"} = $y;
   }
   if (! @{$args -> {"country"}} ) {
      push (@{$args -> {"country"}}, "de");
   }
   init_monate ($args, $data);
   if (!$file_read && ! @{$args -> {"f"}}) {
      $args -> {"f"} = standard_feiertage ($args);
   }
   if (! @{$args -> {"mode"}}) {
      $args -> {"mode"} = ["h7"];
   }
   $args -> {"[cnt]wd"} //= 0;
} # set_default

# Wochentag des 1. Januar
sub wotagstart {
   my $year   = shift;
   my $ostern = datestring_ostern ($year);
   $ostern =~ /^(\d\d)-(\d\d)$/;
   my $mth = $1 + 0;
   my $dy  = $2 + 0;
   $dy += 31 if $mth > 1;
   if ($mth > 2) {
      $dy += 28 + (
         $year % 400 == 0 ? 1 :
         $year % 100 == 0 ? 0 :
         $year %   4 == 0 ? 1 :
         0
      );
   }
   $dy += 31 if $mth > 3;
   $dy += 30 if $mth > 4;
   $dy += 31 if $mth > 5;
   (700 - $dy) % 7 + 1;
} # wotagstart

# Anzahl der Kalenderwochen eines Jahres
sub anzwochen {
   my $year = shift;
   my $dy = 365 + (
      $year % 400 == 0 ? 1 :
      $year % 100 == 0 ? 0 :
      $year %   4 == 0 ? 1 :
      0
   );
   floor ( ($dy + (wotagstart ($year) + 2) % 7 ) / 7);
} # anzwochen

sub init_monate {
   my ($args, $data) = @_;
   my $monate = $data -> {"monate"};
   my $m;      # Monat als Zahl von 0 (Dezember Vorjahr) bis 13 (Januar Folgejahr)
   $m = 0;
   $monate -> [$m] -> [2] = 1 - 31;
   my $year = $args -> {"year"};
   # Tage des Februar korrigieren
   $m = 2;
   $monate -> [$m] -> [1] +=
      $year % 400 == 0 ? 1 :
      $year % 100 == 0 ? 0 :
      $year %   4 == 0 ? 1 :
      0;
   for ($m = 1; $m < 14; ++$m) {
      # 2  Lfd. Nummer des 1. Tages ab 1. Januar,
      $monate -> [$m] -> [2] = $monate -> [$m - 1] -> [2] + $monate -> [$m - 1] -> [1];
   }
} # init_monate

sub init_data {
   my ($args, $data) = @_;
   my $verbose = $args -> {"[cnt]verbose"};

   my $year = $args -> {"year"};
   $data -> {"wotagstart"} = wotagstart ($year);
   $data -> {"aw"}         = anzwochen  ($year);
   $data -> {"awv"}        = anzwochen  ($year - 1);

   # Wochentag des Monatsersten
   my $monate = $data -> {"monate"};
   my $mon;
   for $mon (@$monate) {
      # 2  Lfd. Nummer des 1. Tages ab 1. Januar,
      # 3  Wochentag des Monatsersten von 1 (Mo) bis 7 (So)
      $mon -> [3] = ($mon -> [2] + $data -> {"wotagstart"} + 33) % 7 + 1;
   }

   # Feiertage
   my $f = {};
   $data -> {"f"} = $f;
   for $mon (@{$args -> {"f"}}, @{$args -> {"w"}}) {
      $f -> {$mon} = 1;
   }
} # init_data

sub lnr_to_datestring {
   my $lnr = shift;
   my $monate = $data -> {"monate"};
   my $m = 1;
   while ( $monate -> [$m] -> [1] + $monate -> [$m] -> [2] - 1 < $lnr && $m < 13) {
      ++$m;
   }
   sprintf ("%02d-%02d", $m, $lnr - $monate -> [$m] -> [2] + 1);
} # lnr_to_datestring

sub datestring_ostern {
   my $year = shift;

   # Ostern 2016: 5. April
   # von http://www.gmarts.org/index.php?go=415
   my $a = floor ($year / 100);
   my $b = $year % 100;
   my $c = floor (3 * ($a + 25)) / 4;
   my $d = (3 * ($a + 25)) % 4;
   my $e = floor ((8 * ($a + 11)) / 25);
   my $f = (5 * $a + $b) % 19;
   my $g = (19 * $f + $c - $e) % 30;
   my $h = floor (($f + 11 * $g) / 319);
   my $j = floor ((60 * (5 - $d) + $b) / 4);
   my $k = (60 * (5 - $d) + $b) % 4;
   my $m = (2 * $j - $k - $g + $h) % 7;
   # Monat und Tag des Osterfestes
   my $mth = floor (($g - $h + $m + 114) / 31);
   my $dy  = ($g - $h + $m + 114) % 31 + 1;
   sprintf ("%02d-%02d", $mth, $dy);
} # datesting_ostern

=for comment

Function EasterHodges(dy, mth, ByVal y, ByVal method) As Boolean

'by David Hodges, derived by refining the "Butcher's Ecclesiastical Calendar" rule
'eliminating one step in the process

Dim a, b, c, d, e, f, g, h, j, k, m, n, p
' Validate arguments
    If method <> 3 Or y < 1583 Or y > 4099 Then
        EasterHodges = False
        d = 0
        m = 0
        MsgBox "Hodges method only applies to the revised calculation in the Gregorian calendar from 1583 to 4099 AD"
        Exit Function
    End If
    EasterHodges = True
    a = y \ 100
    b = y Mod 100
    c = (3 * (a + 25)) \ 4
    d = (3 * (a + 25)) Mod 4
    e = (8 * (a + 11)) \ 25
    f = (5 * a + b) Mod 19
    g = (19 * f + c - e) Mod 30
    h = (f + 11 * g) \ 319
    j = (60 * (5 - d) + b) \ 4
    k = (60 * (5 - d) + b) Mod 4
    m = (2 * j - k - g + h) Mod 7
    n = (g - h + m + 114) \ 31
    p = (g - h + m + 114) Mod 31
    dy = p + 1
    mth = n
'Easter Sunday is g - h + m days after March 22nd
'(the earliest possible Easter date)
End Function

=cut

# Standard-Feiertage
sub standard_feiertage {
   my $args   = shift;
   my $year   = $args -> {"year"};
   my $monate = $data -> {"monate"};
   my $list = [
    "01-01", # Neujahr
    "13-01", # Neujahr Folge-Januar
    "05-01", # Maifeiertag
    "10-03", # Tag der deutschen Einheit
    "11-01", # Allerheiligen
    "12-25", # Weihnachten
    "12-26",
    "00-25", # Weihnachten Vor-Dezember
    "00-26",
   ];

   my $ostern = datestring_ostern ($year);
   $ostern =~ /^(\d\d)-(\d\d)$/;
   my $mth = $1 + 0;
   my $dy  = $2 + 0;
   my $ostern_lnr = $dy + $monate -> [$mth] -> [2] - 1;
   push (@$list,
         lnr_to_datestring ($ostern_lnr - 2),  # Karfreitag
         lnr_to_datestring ($ostern_lnr),      # Ostern
         lnr_to_datestring ($ostern_lnr + 1),  # Ostermontag
         lnr_to_datestring ($ostern_lnr + 39), # Himmelfahrt
         lnr_to_datestring ($ostern_lnr + 49), # Pfingsten
         lnr_to_datestring ($ostern_lnr + 50),
      );
   $list;
} # standard_feiertage

# gibt die Version nach STDOUT aus
sub version {
   print << 'VERSION';
KLEIDER/web/src/kalender/base.pl
Basis-Kalenderdaten
2020-04-12
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           Meldungen nach STDERR ausgeben \${[cnt]verbose}
--country    COUNTRY     Kennungen des Landes \${country}
--out        OUT         Ausgabedatei mit Platzhaltern
                         \${out}
--year       YEAR        Kalenderjahr \${year}
--f          F ..        Standard-Feiertage
                         \${f}
--w          W ..        weitere Feiertage
                         \${w}
--ft         FT          Feiertage aus Textdatei FT
                         \${ft}
--mode       MODE ..     Tabellenformate \${mode}
--monmode    MONMODE     de, num oder i \${monmode}
--[no_]wd                Wochentage ausgeben \${[cnt]wd}
--[no_]moncol            Spalte der Monatsnamen \${[cnt]moncol}
--[no_]weekno            Spalte der Wochennummern \${[cnt]weekno}
HELP
   exit 0;
}; # help

read_args   ($args);
set_default ($args);
init_data      ($args, $data);
print_kalender ($args, $data);

sub print_kalender {
   my ($args, $data) = @_;
   my $year = $args -> {"year"};
   my $obase = $args -> {"out"};
   my $fh;
   my $out;
   my $country;
   my $m;
   for $country (@{$args -> {"country"}}) {
      $args -> {"ctry"} = $country;
      $fh  = undef;
      $out = replace ($obase, $args);
      print "Ausgabedatei $out\n" if $args -> {"[cnt]verbose"};
      open ($fh, ">:encoding(utf-8)", $out) or do 
      {
         print STDERR "Kann Datei \"", $out, "\" nicht öffnen: ", $!, "\n"
            if $args -> {"[cnt]verbose"};
         exit;
      };
      $data -> {"fh"} = $fh;
      print $fh <<"HEAD" ;
<?xml version="1.0" encoding ="utf-8"?>
<body
  xmlns    = "http://www.w3.org/1999/xhtml"
  xmlns:kb = "http://herbaer.de/xmlns/20151211/kalenderbilder/"
HEAD
      print $fh "  xmlns:l  = \"http://herbaer.de/xmlns/20141210/localization\"\n"
        if $args -> {"monmode"} eq "i";
      print $fh "  kb:y = \"$year\">\n";
      for ($m = 0; $m < 14; ++$m) {
         print_monat ($args, $data, $m);
      }
      print $fh "</body>\n";
      close $fh;
   }
} # print_kalender

# Ein Monatsblatt ausgeben
sub print_monat {
   my ($args, $data, $m) = @_;
   my $verbose = $args -> {"[cnt]verbose"};
   my $mon     = $data -> {"monate"} -> [$m]; # Liste zum Monat
   my $year    = $args -> {"year"};
   my $mm      = sprintf ("%02d", $m);
   my $monmode = $args -> {"monmode"};
   my $title;
   my $id;     # ID des Monatnamens in der Lokalisierungstabelle
   if ($monmode eq "num") {
      $title = sprintf ("%02d - %d",
         ($m + 11) % 12 + 1,
         $year + floor (($m + 11) / 12) - 1
      );
   }
   elsif ($monmode eq "i") {
      $id = lc ($mon -> [0]);
      $id =~ s/ä/ae/g;
      $id =~ s/ö/oe/g;
      $id =~ s/ü/ue/g;
      $id =~ s/ß/sz/g;
      $title =
        "<l:ph id = \"$id\"/> "
        . sprintf ("%d", $year + floor (($m + 11) / 12) - 1);
   }
   else {
      $title = sprintf ("%s %d",
         $mon -> [0],
         $year + floor (($m + 11) / 12) - 1
      );
   }
   my $fh = $data -> {"fh"};
   print $fh <<"HEAD" ;
<div id="d$mm">
  <h1>$title</h1>
HEAD
   my $d;            # Laufender Tag
   my $n;            # auszugebende Zahl
   my $nr_cell;      # lfd Numer der Zelle;
   my $class;        # Klasse des laufenden Tags
   my $date;         # Datum im Format mm-tt
   my $numcol;       # Anzahl der Spalten bei senkrechter Ausgabe
   my $row;          # laufende Zeile
   my $col;          # laufende Spalte

   my $aw  = anzwochen ($year);      # Anzahl der Wochen akt. Jahr
   my $awv = anzwochen ($year - 1);  # ... Vorjahr
   my $printweek = sub {      
      # erster Tag der ersten Woche
      # (11 - wotagstart) % 7 - 2
      # Woche
      # floor ( (ltag - ((11 - wotagstart) % 7 - 2) + 7) / 7 )
      # = floor ( (ltag - (11 - wotagstart) % 7 + 9) / 7 )
      # = floor ( $d + $mon [2] + 8 - (11 - wotagstart) % 7) / 7)
      my $w = floor ( ($d + $mon -> [2] + 8 - (11 - $data -> {"wotagstart"}) % 7) / 7);
      if    ($w < 1)   { $w += $awv; }
      elsif ($w > $aw) { $w -= $aw;  }
      print $fh "<td class = \"kw\">$w</td>\n";
   };

   my $wd   = $args -> {"[cnt]wd"};
   my $wday;                         # 1 bis 7 für Mo bis So
   my $printdate = sub {
      $class = "";
      if ($d < 1) {
         $n = $d + ($m == 0 ? 30 : $data -> {"monate"} -> [$m - 1] -> [1]);
         $class .= " p";
      }
      elsif ($d > $mon -> [1]) {
         $n = $d - $mon -> [1];
         $class .= " n";
      }
      else {
         $n = $d;
      }
      $date = sprintf ("%02d-%02d", $m, $d);
      $wday = ($mon -> [3] + $d + 5) % 7 + 1;
      $class .= " f"      if $data -> {"f"} -> {$date};
      $class .= " w$wday" if $wd || $wday == 7;
      $class =~ s/^\s+//;
      print $fh "<td";
      print $fh " class=\"$class\"" if $class;
      print $fh ">$n</td>\n";
   };

   my $weekno = $args -> {"[cnt]weekno"};
   my $moncol = $args -> {"[cnt]moncol"};

   my $printmnth = sub {
      print $fh "<td class = \"mc\">";
      if ($monmode eq "num") {
         print $fh sprintf (
            "%02d-%d",
            ($m + 11) % 12 + 1,
            $year + floor (($m + 11) / 12) - 1
            );
      }
      elsif ($monmode eq "i") {
         $id = lc ($mon -> [0]);
         $id =~ s/ä/ae/g;
         $id =~ s/ö/oe/g;
         $id =~ s/ü/ue/g;
         $id =~ s/ß/sz/g;
         print $fh "<l:ph id = \"$id\"/>";
      }
      else {
         print $fh $mon -> [0];
      }
      print $fh "</td>";
   }; # printmnth

   my $mode;    
   my $modkz;  # "h" oder "v"
   my $modno;  # 7 oder 14
   for $mode (@{$args -> {"mode"}}) {
      if ( $mode !~ /^([hv])(7|14)$/ ) {
         print STDERR "ungültiges Tabellenformat --mode \"$mode\"\n"
            if $args -> {"[cnt]verbose"};
         next;
      }
      $modkz = $1;
      $modno = $2;
      if ($modkz eq "h") {
         $nr_cell = 0;
         print $fh "<table class=\"h$modno\">\n";
         for (
            $d = 2 - $mon -> [3];
            $d < 2 - $mon -> [3] + ($mon -> [1] - 1 + $mon -> [3])
            + (42 - ($mon -> [1] - 1 + $mon -> [3])) % $modno ;
            ++$d)
         {
            if ($nr_cell % $modno == 0) {
               print $fh "<tr>\n";
               if ($moncol) {
                  if ($nr_cell == 0) { $printmnth -> (); }
                  else               { print $fh "<td class = \"mc\"/>"; }
               }
               $printweek -> () if $weekno;
            }
            $printdate -> ();
            ++$nr_cell;
            print $fh "</tr>\n" if $nr_cell % $modno == 0;
         }
         print $fh "</table>\n";
      }
      elsif ($modkz eq "v") {
         $nr_cell =
            ($mon -> [1] - 1 + $mon -> [3])
            + (42 - ($mon -> [1] - 1 + $mon -> [3])) % $modno ;
         print $fh "<table class=\"v$modno\">\n";
         if ($moncol) {
             print $fh "<tr class = \"mc\">";
             $printmnth -> ();
             for ($col = 1; $col * $modno < $nr_cell; ++$col) {
                print $fh "<td class = \"mc\"/>";
             }
             print $fh "</tr>\n";
         }
         if ($weekno) {
             print $fh "<tr class = \"kw\">\n";
             for ($col = 0; $col * $modno < $nr_cell; ++$col) {
                 $d = 2 - $mon -> [3] + $col * $modno;
                 $printweek -> ();
             }
         }
         print $fh "</tr>\n";
         for ($row = 0; $row < $modno; ++$row) {
            print $fh "<tr>\n";
            for ($col = 0; $col * $modno < $nr_cell; ++$col) {
               $d = 2 - $mon -> [3] + $col * $modno + $row;
               $printdate -> ();
            }
            print $fh "</tr>\n";
         }
         print $fh "</table>\n";
      }
   }
   print $fh "</div>\n" ;
} # print_monat

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