—

              
#!/usr/local/bin/perl -w
#
#     Example script for DateTime::Calendar::FrenchRevolutionary:
#     print a few tables for an easy conversion of date from French Revolutionary to Gregorian
#     Copyright (C) 2003, 2004, 2010, 2011, 2014, 2016, 2019, 2021 Jean Forget. All rights reserved.
#
#     See the license in the embedded documentation below.
#
use utf8;
use strict;
use Getopt::Long;
use DateTime::Calendar::FrenchRevolutionary;
use FindBin;
use constant DEBUG => 0;
my ($columns, $lang, $last, $example, $table_workaround) 
 = (       9,  'en',    400,    80218, 0);
GetOptions('columns=i'        => \$columns
        ,  'lang=s'           => \$lang
        ,  'example=s'        => \$example
        ,  'table-workaround' => \$table_workaround
       );
die "At least 5 colmuns" if $columns < 5;
die "The number of columns must be a multiple of 4 plus 1 (e.g. 5, 9 or 13)"
  unless $columns % 4 == 1;
binmode STDOUT, ':utf8';
--$columns; # because actually we do not want to be bothered with the heading column
# Because the  Gregorian leap day  may occur in  the middle of  a French
# Revolutionary year,  each F-R  year is divided  into two  parts: begin
# (Vendémiaire  to  mid-Ventôse)  and  end  (mid-Ventôse  to  additional
# days). The French Revolutionary leap  day is not a problem, it appears
# at  the  end of  the  year,  and therefore  has  no  influence on  the
# formulas.
my @parts = ('b', 'e');
# For each year and each part, we store the G day number of a specific F-R day.
# This specific day is
#      b => 1 Vendémiaire => ?? September
#      e => 1 Germinal    => ?? March
# We partially store the reverse : for each part or year and each G day number,
# which year can be taken as an sample.
my @day_of_yearpart;
my %year_of_partday;
# We fill the list of hashes, and the hash of hashes
foreach my $part (@parts)
  { day_of_yearpart($_, $part) foreach (1..$last) }
if (DEBUG)
  {
    for my $year (1 .. $last)
      {
        print ' ', day_of_yearpart($year, $_) foreach (@parts);
        print "\n" if $year % 4 == 3;
      }
    print "\n";
  }
# The tables do not contain the Sep-Mar day number, but a letter, which is easier
# to remember. So to each part - day number combination, we assign a letter.
# The ordering part then year is more pleasing than the other when reading 
# the final charts.
my $next_letter = 'a';
my %letter_of_partday  = ();
foreach my $part (@parts)
  {
    foreach (sort { $a <=> $b } keys %{$year_of_partday{$part}})
      {
        # print STDERR "$part $_ $next_letter\n";
        $letter_of_partday{$part}{$_} = $next_letter ++;
        ++$next_letter if $next_letter eq 'i'; # To prevent i<->j confusion
      }
  }
if (DEBUG)
  {
    for my $year (1 .. $last)
      {
        print ' ', $year, ' ', word_for_year($year);
        print "\n" if $year % 4 == 0
      }
    print "\n";
  }
# The year -> 2-letter word function is periodic, except for a few glitches
# each time the Gregorian or F-R century changes. So, years are grouped
# by four, eight, twelve or more each group is identified by a 8-, 16- or 
# 24-letter word. Interval are built so if two years n and n+4 (or n+8,
# or n+12) have the same formulas, they may belong to the same interval.
# If the formulas are different, the interval ends and a new interval
# begins.
my %line_for_interval;
my %end_of_interval;
build_intervals();
if (DEBUG)
  {
    print "$_ $end_of_interval{$_} $line_for_interval{$_}\n" 
       foreach (sort { $a <=> $b } keys %line_for_interval);
  }
# Some language-dependant variables are set in the "done" files.
# Therefore, they cannot be "my" variables, they must be global.
# I don't use "our", because it would break in older versions.
my $ref_labels;
if ($lang eq 'fr')
  { $ref_labels = do "$FindBin::Bin/labels_fr" }
else
  { $ref_labels = do "$FindBin::Bin/labels_en" }
my %labels = %$ref_labels;
my @fr_month = qw (Vendémiaire Brumaire Frimaire Nivôse   Pluviôse  Ventôse 
                   Germinal    Floréal  Prairial Messidor Thermidor Fructidor);
push @fr_month, "Sans-Culottides<br>$labels{add_days}";
html_0($labels{titler2g});
html_1($labels{title1});
html_2($_) foreach (@parts);
print "<table><tr><td>\n" if $table_workaround;
usage($example);
print "</td></tr></table>\n" if $table_workaround;
print "</body>\n</html>\n";
#
# Gives the letter for a year and a part
# creating one if necessary
#
sub day_of_yearpart {
  my ($year, $part) = @_; # year: 1 to 400 or so, $part: b, e
  # memoized version
  return $day_of_yearpart[$year]{$part} if $day_of_yearpart[$year]{$part};
  # computed version
  my $month = $part eq 'b' ? 1 : 7;
  #my $date =  new Date::Convert::French_Rev $year, $month, 1;
  #convert Date::Convert::Gregorian $date;
  my $date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month));
  my $day = $date->day();
  # if no sample year yet, remember this one
  $year_of_partday{$part}{$day} = $year unless $year_of_partday{$part}{$day};
  $day_of_yearpart[$year]{$part} = $day;
}
sub word_for_year {
  my ($year) = @_;
  join '', map { letter_of_yearpart($year, $_) } @parts;
}
sub letter_of_yearpart {
  my ($year, $part) = @_;
  $letter_of_partday{$part}{$day_of_yearpart[$year]{$part}};
}
sub build_intervals {
  my $current_start = 1;
  %line_for_interval = (1 => '  ' x $columns);
  $end_of_interval{1}   = 4;
  foreach my $year (1..$last) {
    my $old_line = $line_for_interval{$current_start};
    my $new_line = '  ' x $columns;
    substr($new_line, $year % 100 % $columns * 2, 2) = word_for_year($year);
    my $intersection = $old_line & $new_line;
    $intersection =~ tr / /./;
    unless ($old_line =~ m{$intersection} && $new_line =~ m{$intersection}) {
      $current_start = $year;
      $line_for_interval{$year} = $new_line;
    }
    $line_for_interval{$current_start} |= $new_line;
    $end_of_interval{$current_start} = $year;
  }
}
#
# Compute the formulas for a sample year and for a month.
# 1st Vendémiaire I is 22 September 1792, and 30 Vendémiaire I is 21 October I.
# Therefore, for Vendémiaire I, we have two formulas : "+21 Sep" and "-9 Oct".
# Since all French Revolutionary months have 30 days, only one computation is necessary.
# Exception: the additional days are grouped in a notional 13th month, which lasts
# either 5 or 6 days. In this case, we have 3 formulas for September, at the cost of 2 conversions.
#
sub formulas {
  my ($year, $month) = @_;
  my @formulas = ();
  my @month = qw(Sep Oct Nov Dec Jan Feb Mar Apr May Jun Jul Aug Sep);
  #my $date = new Date::Convert::French_Rev $year, $month, 1;
  #convert Date::Convert::Gregorian $date;
  my $date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month));
  my $offset = $date->day() - 1;
  push @formulas, "+$offset $labels{month3}[$date->month_0]";
  if ($month < 13)
    {
      #$date = new Date::Convert::French_Rev $year, $month, 30;
      #convert Date::Convert::Gregorian $date;
      $date = DateTime->from_object(object => DateTime::Calendar::FrenchRevolutionary->new(year => $year, month => $month, day => 30));
      $offset = 30 - $date->day();
      push @formulas, "-$offset $labels{month3}[$date->month() - 1]";
    }
  @formulas;
}
sub html_0 {
  my ($title) = @_;
  print <<"EOF";
<html>
<head>
<title>$title</title>
<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" />
</head>
<body>
<h1>$title</h1>
EOF
}
sub html_1 {
  my ($title1) = @_;
  print "<table border><tr><td></td><th align='center' colspan='$columns'>$title1</th></tr><tr align='right'><td></td>\n";
  foreach my $n1 (0 .. $columns - 1)
    {
      printf "<td>%2d", $n1;
      for(my $n0 = $n1 + $columns; $n0 <= 99; $n0 += $columns) 
        { printf "<br>%2d", $n0 % 100 }
      print "<br>&nbsp;" if $n1 > 99 % $columns; # better aligned numbers
      print "</td>\n";
    }
  print "</tr>\n";
  foreach my $year1 (sort { $a <=> $b } keys %end_of_interval)
    {
      print "<tr align='center'><td>$year1 - $end_of_interval{$year1}";
      my $line = $line_for_interval{$year1};
      $line =~ s=(..)=</td><td>$1=g;
      print "$line</td></tr>\n";
    }
  print "</table>\n";
}
sub html_2 {
  my ($part)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  my $colspan = @days + 1;
  print "<p><table border><tr><th align='center' colspan='$colspan'>$labels{title2}{$part}</th></tr>\n";
  if ($part eq 'b')
    {
      html_2header(1791, $part);
      html_two_formulas($part, $_  ) foreach(1..3);
      html_one_formula ($part, 4, 0);
      html_2header(1792, $part);
      html_one_formula ($part, 4, 1);
      html_two_formulas($part, 5);
      html_one_formula ($part, 6, 0);
    }
  else
    {
      html_2header(1792, $part);
      html_one_formula ($part,  6, 1);
      html_two_formulas($part, $_  ) foreach(7..12);
      html_one_formula ($part, 13, 0);
    }
  print "</table>\n";
}
sub html_2header {
  my ($offset, $part) = @_;
  my @letters = sort values %{$letter_of_partday{$part}};
  print "<tr align='center'><th>"
      , join('</th><th>', "$labels{year_ttl} + $offset", @letters)
      , "</th></tr>\n"; 
}
sub html_two_formulas {
  my ($part, $month)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  print "<tr align='center'><td>$fr_month[$month - 1]</td>";
  foreach (@days)
    {
      my $year = $year_of_partday{$part}{$_};
      my @formulas = formulas($year, $month);
      print "<td>$formulas[0]<br>$formulas[1]</td>\n";
    }
  print "</tr>\n";
}
sub html_one_formula {
  my ($part, $month, $nb)  = @_;
  my @days    = sort { $a <=> $b } keys %{$letter_of_partday{$part}};
  print "<tr align='center'><td>$fr_month[$month - 1]</td>";
  foreach (@days)
    {
      my $year = $year_of_partday{$part}{$_};
      my @formulas = formulas($year, $month);
      print "<td>$formulas[$nb]</td>\n";
    }
  print "</tr>\n";
}
sub usage {
  my ($day) = @_;
  my ($y, $m, $d) = unpack "A4A2A2", sprintf "%08d", $day;
  $y += 0; # Remove the leading zeros
  # We want neither Ventôse nor additional days for the first example,
  # so we choose a random month.
  if ($m == 6 || $m == 13)
    {
      my @m = qw(1 2 3 4 5 7 8 9 10 11 12);
      $m = $m[11 * rand];
    }
  # First example
  #my $date = new Date::Convert::French_Rev $y, $m, $d;
  #convert Date::Convert::Gregorian $date;
  my $date_r   = DateTime::Calendar::FrenchRevolutionary->new(year => $y, month => $m, day => $d);
  my $date_g   = DateTime->from_object(object => $date_r);
  my $title_date = $date_r->strftime("%d %B %EY");
  my $y2       = sprintf "%02d", $y % 100;
  my $part     = $m <= 6 ? 'b' : 'e';
  my $offset   = $part eq 'e' ? 1792 : 1791;
  my $letter   = letter_of_yearpart($y, $part);
  my $word     = word_for_year($y);
  my @formulas = formulas($y, $m);
  my $limit    = $1 if $formulas[1] =~ /(\d+)/;
  my $formula  = $formulas[$d <= $limit ? 0 : 1];
  my $gyear    = $date_g->year;
  my $gmonth   = $date_g->month;
  my $gday     = $date_g->day;
  my $begint; # Beginning of the interval
  foreach (sort { $a <=> $b } keys %end_of_interval)
    {
      last if $y < $_;
      $begint = $_;
    }
  my $gr_date  = &{$labels{format}}($gyear, $gmonth, $gday, $lang);
  $_ = eval "qq($labels{usage3})";
  print;
  print "\n";
  # Second example: Ventôse
  # $m = 6;
  #$date = new Date::Convert::French_Rev $y, 6, $d;
  #$title_date = $date->date_string("%d %B %EY");
  #convert Date::Convert::Gregorian $date;
  $date_r   = DateTime::Calendar::FrenchRevolutionary->new(year => $y, month => 6, day => $d);
  $date_g   = DateTime->from_object(object => $date_r);
  $title_date = $date_r->strftime("%d %B %EY");
  @formulas   = formulas($y, 6);
  my $bletter = letter_of_yearpart($y, 'b');
  my $eletter = letter_of_yearpart($y, 'e');
  $gyear      = $date_g->year;
  $gmonth     = $date_g->month;
  $gday       = $date_g->day;
  $gr_date  = &{$labels{format}}($gyear, $gmonth, $gday, $lang);
  $limit = $1 if $formulas[1] =~ /(\d+)/;
  if ($d <= $limit)
    { $formula = $formulas[0]; $offset = 1791 }
  else
    { $formula = $formulas[1]; $offset = 1792 }
  $_ = eval "qq($labels{usage4})";
  print;
}
__END__
HideShow 107 lines of Pod
=encoding utf8
=head1 NAME
r2g_table -  Print a few  charts which can  be used to convert  a date from the French Revolutionary calendar to the Gregorian calendar.
=head1 SYNOPSIS
r2g_table [--columns=I<nb>] [--example=I<date>] [--lang=I<language>] [--table-workaround]
=head1 DESCRIPTION
This program prints three tables, plus a small text showing how to use
these tables.   The output uses  UTF-8 encoding and HTML  format. When
printed  from  a  table-aware   web  browser,  these  tables  allow  a
computer-less  user to  convert  dates from  the French  Revolutionary
calendar to the Gregorian calendar.
=head1 OPTIONS
=over 4
=item columns
The number of columns in the  the first table. This must be a multiple
of 4, plus  1. With 5, you  get a narrow table with  many lines, while
with 13 or even 17, you get a wide table with fewer lines.
=item example
The  instructions for  use need  a date  as an  example. The  user can
select the  date that  will be used  as an example  (French Revolution
date,  YYYYMMDD numeric  format). Actually,  the instructions  use two
examples: the first one not in Ventôse, the second one in Ventôse.  If
the user provides a date in  Ventôse, the program will select a random
month for the first example.
=item lang
Select  the language  that  will be  used  for all  language-dependant
elements, including the instructions for use. Available languages are:
=over 4
=item en
English (default)
=item us
English, with the Gregorian dates formatted in the US way (December 1,
2001)
=item fr
French
=back
=item table-workaround
I have noticed that when one of the web browsers I use renders tables,
it has  problems with  plain text following  the tables, and  it might
skip a few  plain text lines. In the present case,  the first lines of
the  instructions for  use  disappear.  The  workaround  I have  found
consists in  building a  table around the  instructions for  use. This
option triggers this workaround.
=back
=head1 AUTHOR
Jean Forget <JFORGET@cpan.org>
=head1 LICENSE STUFF
Copyright  (c) 2003,  2004, 2010,  2012, 2014,  2016, 2019,  2021 Jean
Forget. All  rights reserved. This  program is free software.  You can
distribute,      adapt,     modify,      and     otherwise      mangle
DateTime::Calendar::FrenchRevolutionary under  the same terms  as perl
5.16.3.
This program is  distributed under the same terms  as Perl 5.16.3: GNU
Public License version 1 or later and Perl Artistic License
You can find the text of the licenses in the F<LICENSE> file or at
L<https://dev.perl.org/licenses/artistic.html>
and L<https://www.gnu.org/licenses/gpl-1.0.html>.
Here is the summary of GPL:
This program is  free software; you can redistribute  it and/or modify
it under the  terms of the GNU General Public  License as published by
the Free  Software Foundation; either  version 1, or (at  your option)
any later version.
This program  is distributed in the  hope that it will  be useful, but
WITHOUT   ANY  WARRANTY;   without  even   the  implied   warranty  of
MERCHANTABILITY  or FITNESS  FOR A  PARTICULAR PURPOSE.   See  the GNU
General Public License for more details.
You should  have received  a copy  of the  GNU General  Public License
along with this program;  if not, see L<https://www.gnu.org/licenses/>
or contact the Free Software Foundation, Inc., L<https://www.fsf.org>.
=cut