1#!/usr/local/bin/perl -w 2# 3# Example script for DateTime::Calendar::FrenchRevolutionary: 4# print a few tables for an easy conversion of dates from Gregorian to French Revolutionary 5# Copyright (C) 2003, 2004, 2010, 2011, 2014, 2016, 2019, 2021 Jean Forget. All rights reserved. 6# 7# See the license in the embedded documentation below. 8# 9 10use utf8; 11use strict; 12use Getopt::Long; 13use DateTime::Calendar::FrenchRevolutionary; 14use FindBin; 15use constant DEBUG => 0; 16 17my ($columns, $lang, $last, $example, $table_workaround) 18 = ( 9, 'en', 2099, 17991109, 0); 19 20GetOptions('columns=i' => \$columns 21 , 'lang=s' => \$lang 22 , 'example=s' => \$example 23 , 'table-workaround' => \$table_workaround 24 ); 25die "At least 5 columns" if $columns < 5; 26die "The number of columns must be a multiple of 4 plus 1 (e.g. 5, 9 or 13)" 27 unless $columns % 4 == 1; 28 29binmode STDOUT, ':utf8'; 30 31--$columns; # because actually we do not want to be bothered with the heading column 32 33# Because both the Gregorian leap day and the French Revolutionary leap 34# day occur in the middle of a Gregorian year, each year is divided into 35# three parts: begin (January to February), middle (March to mid-September) and 36# end (mid-September to December). 37my @parts = ('b', 'm', 'e'); 38 39# For each year and each part, we store the F_R day number of a specific G day. 40# This specific day is 41# b => 1 January 42# m => 1 March 43# e => 1 October 44# We partially store the reverse : for each part or year and each F_R day number, 45# which year can be taken as an sample. 46my %day_of_yearpart; 47my %year_of_partday; 48 49# We fill the hashes. There is a special case with 1792, because the beginning 50# and middle cannot be converted to F-R. So we store out-of-bounds values in the hash. 51foreach my $part (@parts) 52 { day_of_yearpart($_, $part) foreach (1793..$last) } 53 54$day_of_yearpart{1792}{'b'} = 1; 55$day_of_yearpart{1792}{'m'} = 1; 56day_of_yearpart(1792, 'e'); 57 58if (DEBUG) 59 { 60 for my $year (1792 .. $last) 61 { 62 print ' ', day_of_yearpart($year, $_) foreach (@parts); 63 print "\n" if $year % 4 == 3; 64 } 65 print "\n"; 66 } 67 68# The output tables do not contain the Jan-Mar-Oct day number, but a letter, 69# which is easier to remember. So to each part - day number combination, we 70# assign a letter. 71my $next_letter = 'a'; 72my %letter_of_partday; 73foreach my $part (@parts) 74 { 75 foreach (sort { $a <=> $b } keys %{$year_of_partday{$part}}) 76 { 77 # print STDERR "$part $_ $next_letter\n"; 78 $letter_of_partday{$part}{$_} = $next_letter ++; 79 ++$next_letter if $next_letter eq 'i'; # To prevent i<->j confusion 80 } 81 } 82$letter_of_partday{'b'}{$day_of_yearpart{1792}{'b'}} = ' '; 83$letter_of_partday{'m'}{$day_of_yearpart{1792}{'m'}} = ' '; 84 85if (DEBUG) 86 { 87 for my $year (1792 .. $last) 88 { 89 print ' ', $year, ' ', word_for_year($year); 90 print "\n" if $year % 4 == 3; 91 } 92 print "\n"; 93 } 94 95# The year -> 3-letter word function is periodic, except for a few glitches 96# each time the Gregorian or F-R century changes. So, years are grouped 97# by four, each group is identified by a 12-letter word. 98# The groups are merged into intervals if they have the same word. 99 100my %line_for_interval; 101my %end_of_interval; 102build_intervals(); 103 104if (DEBUG) 105 { 106 print "$_ $end_of_interval{$_} $line_for_interval{$_}\n" 107 foreach (sort { $a <=> $b } keys %line_for_interval); 108 } 109 110# Some language-dependant variables are set in the "done" files. 111# Therefore, they cannot be "my" variables, they must be global. 112# I don't use "our", because it would break in older versions. 113 114my $ref_labels; 115if ($lang eq 'fr') 116 { $ref_labels = do "$FindBin::Bin/labels_fr" } 117else 118 { $ref_labels = do "$FindBin::Bin/labels_en" } 119my %labels = %$ref_labels; 120 121html_0($labels{titleg2r}); 122html_1($labels{title1}); 123html_2($_) foreach (@parts); 124print "<p>\n"; 125html_3($labels{title3}); 126print "<p>\n"; 127print "<table><tr><td>\n" if $table_workaround; 128usage($example); 129print "</td></tr></table>\n" if $table_workaround; 130print "</body>\n</html>\n"; 131 132# 133# Gives the letter for a year and a part 134# creating one if necessary 135# 136sub day_of_yearpart { 137 my ($year, $part) = @_; # year: 1792 to 2300 or so, $part: b, m, e 138 139 # memoized version 140 return $day_of_yearpart{$year}{$part} if $day_of_yearpart{$year}{$part}; 141 142 # computed version 143 my $month = $part eq 'b' ? 1 : $part eq 'm' ? 3 : 10; 144 #my $date = new Date::Convert::Gregorian $year, $month, 1; 145 #convert Date::Convert::FrenchRevolutionary $date; 146 my $dg = DateTime->new(year => $year, month => $month); 147 my $dr = DateTime::Calendar::FrenchRevolutionary->from_object(object => $dg); 148 my $day = $dr->day(); 149 # if no sample year yet, remember this one 150 $year_of_partday{$part}{$day} = $year unless $year_of_partday{$part}{$day}; 151 $day_of_yearpart{$year}{$part} = $day; 152} 153 154#sub word_for_interval { 155# my ($year) = @_; 156# join '', map { word_for_year($year + $_) } (0..3); 157#} 158 159sub word_for_year { 160 my ($year) = @_; 161 join '', map { letter_of_yearpart($year, $_) } @parts; 162} 163 164sub letter_of_yearpart { 165 my ($year, $part) = @_; 166 $letter_of_partday{$part}{$day_of_yearpart{$year}{$part}}; 167} 168 169sub build_intervals { 170 my $current_start = 1792; 171 %line_for_interval = (1792 => ' ' x $columns); 172 173 foreach my $year (1792..$last) 174 { 175 my $old_line = $line_for_interval{$current_start}; 176 my $new_line = ' ' x $columns; 177 substr($new_line, $year % 100 % $columns * 3, 3) = word_for_year($year); 178 my $intersection = $old_line & $new_line; 179 $intersection =~ tr / /./; 180 unless ($old_line =~ m{$intersection} && $new_line =~ m{$intersection}) { 181 $current_start = $year; 182 $line_for_interval{$year} = $new_line; 183 } 184 $line_for_interval{$current_start} |= $new_line; 185 $end_of_interval{$current_start} = $year; 186 } 187} 188 189# 190# Compute the formulas for a sample year and for a month. 191# 1st January 1796 is 11 Nivôse IV, and 31 January 1796 is 11 Pluviôse IV. 192# Therefore, for January 1796, we have two formulas : "+10 Niv" and "-20 Plu". 193# Since all French Revolutionary months have 30 days, only one computation is necessary. 194# Exception: the additional days are grouped in a notional 13th month, which lasts 195# either 5 or 6 days. In this case, we have 3 formulas for September, at the cost of 2 conversions. 196# 197sub formulas { 198 my ($year, $month) = @_; 199 my @formulas = (); 200 my @month = qw(Niv Plu Vnt Ger Flo Pra Mes The Fru S-C Vnd Bru Fri Niv); 201 #my $date = new Date::Convert::Gregorian $year, $month, 1; 202 #convert Date::Convert::FrenchRevolutionary $date; 203 my $dg = DateTime->new(year => $year, month => $month); 204 my $dr = DateTime::Calendar::FrenchRevolutionary->from_object(object => $dg); 205 my $offset = $dr->day() - 1; 206 if ($month <= 9) # Have to split in two, because of the additional days within @month 207 { 208 push @formulas, "+$offset $month[$month - 1]"; 209 $offset = 30 - $offset; 210 push @formulas, "-$offset $month[$month]"; 211 } 212 else 213 { 214 push @formulas, "+$offset $month[$month]"; 215 $offset = 30 - $offset; 216 push @formulas, "-$offset $month[$month + 1]"; 217 } 218 if ($month == 9) 219 { 220 #$date = new Date::Convert::FrenchRevolutionary $year - 1791, 1, 1; 221 #convert Date::Convert::Gregorian $date; 222 $dr = DateTime::Calendar::FrenchRevolutionary->new(year => $year - 1791); 223 $dg = DateTime->from_object(object => $dr); 224 $offset = $dg->day() - 1; 225 push @formulas, "-$offset Vnd"; 226 } 227 228 @formulas; 229} 230 231sub html_0 { 232 my ($title) = @_; 233 print <<"EOF"; 234<html> 235<head> 236<title>$title</title> 237<meta http-equiv="Content-Type" content="text/html; charset=UTF-8" /> 238</head> 239<body> 240<h1>$title</h1> 241EOF 242} 243 244sub html_1 { 245 my ($title1) = @_; 246 print "<table border><tr><td></td><th align='center' colspan='$columns'>$title1</th></tr><tr align='right'><td></td>\n"; 247 foreach my $n1 (0 .. $columns - 1) 248 { 249 printf "<td>%2d", $n1; 250 for (my $n0 = $n1 + $columns; $n0 <= 99; $n0 += $columns) 251 { printf "<br>%2d", $n0 } 252 print "<br> " if $n1 > 99 % $columns; # better aligned numbers 253 print "</td>\n"; 254 } 255 print "</tr>\n"; 256 foreach my $year1 (sort { $a <=> $b } keys %end_of_interval) 257 { 258 print "<tr align='center'><td>$year1 - $end_of_interval{$year1}"; 259 my $line = $line_for_interval{$year1}; 260 $line =~ s=(...)=</td><td>$1=g; 261 print $line; 262 print "</td></tr>\n"; 263 } 264 print "</table>\n"; 265} 266 267sub html_2 { 268 my ($part) = @_; 269 my @days = sort { $a <=> $b } grep { $_ != 1 } keys %{$letter_of_partday{$part}}; 270 my $colspan = @days + 1; 271 print "<p><table border><tr><th align='center' colspan='$colspan'>$labels{title2}{$part}</th></tr>\n"; 272 html_2header($part eq 'e' ? 1791 : 1792, $part); 273 # the part of September in the end of the year 274 if ($part eq 'e') { 275 print "<tr align='center'><td>$labels{month}[8]</td>"; 276 foreach (@days) { 277 my $year = $year_of_partday{$part}{$_}; 278 my @formulas = formulas($year, 9); 279 print "<td>$formulas[2]</td>\n"; 280 } 281 print "</tr>\n"; 282 } 283 # The regular months of the part of the year 284 my @month_list = $part eq 'b' ? (1..2) : $part eq 'm' ? (3..9) : (10..12); 285 foreach my $month (@month_list) { 286 print "<tr align='center'><td>$labels{month}[$month - 1]</td>"; 287 foreach (@days) { 288 my $year = $year_of_partday{$part}{$_}; 289 my @formulas = formulas($year, $month); 290 print "<td>$formulas[0]<br>$formulas[1]</td>\n"; 291 } 292 print "</tr>\n"; 293 } 294 295 print "</table>\n"; 296} 297 298sub html_2header { 299 my ($offset, $part) = @_; 300 my @letters = sort grep { $_ ne ' ' } values %{$letter_of_partday{$part}}; 301 print "<tr align='center'><th>" 302 , join('</th><th>', "$labels{year_ttl} - $offset", @letters) 303 , "</th></tr>\n"; 304} 305 306sub html_3 { 307 my ($title3) = @_; 308 print <<"HTML"; 309<p> 310<table border> 311<tr><th colspan='7'>$labels{title3}</th></tr> 312<tr><td>Vnd</td><td>Vendémiaire</td><td></td> 313 <td align = 'right'>1</td><td align = 'right'>11</td><td align = 'right'>21</td> 314 <td>Primedi / Primidi</td></tr> 315<tr><td>Bru</td><td>Brumaire</td><td></td> 316 <td align = 'right'>2</td><td align = 'right'>12</td><td align = 'right'>22</td> 317 <td>Duodi</td></tr> 318<tr><td>Fri</td><td>Frimaire</td><td></td> 319 <td align = 'right'>3</td><td align = 'right'>13</td><td align = 'right'>23</td> 320 <td>Tridi</td></tr> 321<tr><td>Niv</td><td>Nivôse</td><td></td> 322 <td align = 'right'>4</td><td align = 'right'>14</td><td align = 'right'>24</td> 323 <td>Quartidi</td></tr> 324<tr><td>Plu</td><td>Pluviôse</td><td></td> 325 <td align = 'right'>5</td><td align = 'right'>15</td><td align = 'right'>25</td> 326 <td>Quintidi</td></tr> 327<tr><td>Vnt</td><td>Ventôse</td><td></td> 328 <td align = 'right'>6</td><td align = 'right'>16</td><td align = 'right'>26</td> 329 <td>Sextidi</td></tr> 330<tr><td>Ger</td><td>Germinal</td><td></td> 331 <td align = 'right'>7</td><td align = 'right'>17</td><td align = 'right'>27</td> 332 <td>Septidi</td></tr> 333<tr><td>Flo</td><td>Floréal</td><td></td> 334 <td align = 'right'>8</td><td align = 'right'>18</td><td align = 'right'>28</td> 335 <td>Octidi</td></tr> 336<tr><td>Pra</td><td>Prairial</td><td></td> 337 <td align = 'right'>9</td><td align = 'right'>19</td><td align = 'right'>29</td> 338 <td>Nonidi</td></tr> 339<tr><td>Mes</td><td>Messidor</td><td></td> 340 <td align = 'right'>10</td><td align = 'right'>20</td><td align = 'right'>30</td> 341 <td>Décadi</td></tr> 342<tr><td>The</td><td>Thermidor</td></tr> 343<tr><td>Fru</td><td>Fructidor</td></tr> 344<tr><td>S-C</td><td colspan='7'>Sans-Culottides / $labels{add_days}</td></tr> 345</table> 346<p> 347HTML 348} 349 350sub usage { 351 my ($day) = @_; 352 my ($y, $m, $d) = unpack "A4A2A2", $day; 353 # We do not want September for the first example, so we choose a random month 354 # except February (in order to punt the problem of a 29th or 30th February) 355 if ($m == 9) 356 { 357 my @m = qw(1 3 4 5 6 7 8 10 11 12); 358 $m = $m[10 * rand]; 359 } 360 361 # First example 362 my $gr_date = &{$labels{format}}($y, $m, $d, $lang); 363 #my $date = new Date::Convert::Gregorian $y, $m, $d; 364 #convert Date::Convert::FrenchRevolutionary $date; 365 my $date = DateTime::Calendar::FrenchRevolutionary->from_object(object => DateTime->new(year => $y, month => $m, day => $d)); 366 my $y2 = sprintf "%02d", $y % 100; 367 my $part = $m <= 2 ? 'b' : $m < 9 ? 'm' : 'e'; 368 my $offset = $part eq 'e' ? 1791 : 1792; 369 my $letter = letter_of_yearpart($y, $part); 370 my $word = word_for_year($y); 371 my @formulas = formulas($y, $m); 372 my $limit = $1 if $formulas[1] =~ /(\d+)/; 373 my $formula = $formulas[$d <= $limit ? 0 : 1]; 374 my $ryear = $date->year(); 375 my $begint; # Beginning of the interval 376 foreach (sort { $a <=> $b } keys %end_of_interval) 377 { 378 last if $y < $_; 379 $begint = $_; 380 } 381 my $abridged = $date->strftime("%e %b"); 382 my $rev_date = $date->strftime("%A %e %B %EY"); 383 $_ = eval "qq($labels{usage1})"; 384 print; 385 print "\n"; 386 387 # Second example: September 388 # $m = 9; 389 $gr_date = &{$labels{format}}($y, 9, $d, $lang); 390 #$date = new Date::Convert::Gregorian $y, 9, $d; 391 #convert Date::Convert::FrenchRevolutionary $date; 392 $date = DateTime::Calendar::FrenchRevolutionary->from_object(object => DateTime->new(year => $y, month => 9, day => $d)); 393 @formulas = formulas($y, 9); 394 my $mletter = letter_of_yearpart($y, 'm'); 395 my $eletter = letter_of_yearpart($y, 'e'); 396 $abridged = $date->strftime("%e %b %Y"); 397 $rev_date = $date->strftime("%A %e %B %EY"); 398 $limit = $1 if $formulas[1] =~ /(\d+)/; 399 if ($d <= $limit) 400 { $formula = $formulas[0]; $offset = 1792 } 401 else 402 { 403 $limit = $1 if $formulas[2] =~ /(\d+)/; 404 if ($d <= $limit) 405 { $formula = $formulas[1]; $offset = 1792 } 406 else 407 { $formula = $formulas[2]; $offset = 1791 } 408 } 409 $_ = eval "qq($labels{usage2})"; 410 print; 411} 412 413__END__ 414 415=encoding utf8 416 417=head1 NAME 418 419g2r_table - Print a few charts which can be used to convert a date from the Gregorian calendar to the French Revolutionary calendar. 420 421=head1 SYNOPSIS 422 423g2r_table [--columns=I<number>] [--example=I<date>] [--lang=I<language>] [--table-workaround] 424 425=head1 DESCRIPTION 426 427This program prints five tables, plus a small text showing how to use 428these tables. The output uses UTF-8 encoding and HTML format. When 429printed from a table-aware web browser, these tables allow a 430computer-less user to convert dates from the Gregorian calendar to the 431French Revolutionary calendar. 432 433=head1 OPTIONS 434 435=over 4 436 437=item columns 438 439The number of columns in the first table. This number must be a 440multiple of 4 (because of the 4-year quasi-cycle for leap days) plus 441one (for the first line, giving year intervals). So you can choose 5, 4429, 13 or 17. Higher number are allowed, but they will not give 443beutiful results. 444 445=item example 446 447The instructions for use need a date as an example. The user can 448select the date that will be used as an example (Gregorian date, 449YYYYMMDD numeric format). Actually, the instructions use two examples: 450the first one not in September, the second one in September. If the 451user provides a date in September, the program will select a random 452month for the first example. 453 454=item lang 455 456Select the language that will be used for all language-dependant 457elements, including the instructions for use. 458 459=over 4 460 461=item en 462 463English (default) 464 465=item us 466 467English, with the Gregorian dates formatted in the US way (December 1, 4682001) 469 470=item fr 471 472French 473 474=back 475 476=item table-workaround 477 478I have noticed that when my web browser renders and prints tables, it 479has problems with plain text following the tables, and it might skip a 480few plain text lines. In the present case, the first lines of the 481instructions for use disappear. The workaround I have found consists 482in building a table around the instructions for use. This option 483triggers this workaround. 484 485=back 486 487=head1 AUTHOR 488 489Jean Forget <JFORGET@cpan.org> 490 491=head1 LICENSE STUFF 492 493Copyright (c) 2003, 2004, 2010, 2012, 2014, 2016, 2019, 2021 Jean 494Forget. All rights reserved. This program is free software. You can 495distribute, adapt, modify, and otherwise mangle 496DateTime::Calendar::FrenchRevolutionary under the same terms as perl 4975.16.3. 498 499This program is distributed under the same terms as Perl 5.16.3: GNU 500Public License version 1 or later and Perl Artistic License 501 502You can find the text of the licenses in the F<LICENSE> file or at 503L<https://dev.perl.org/licenses/artistic.html> 504and L<https://www.gnu.org/licenses/gpl-1.0.html>. 505 506Here is the summary of GPL: 507 508This program is free software; you can redistribute it and/or modify 509it under the terms of the GNU General Public License as published by 510the Free Software Foundation; either version 1, or (at your option) 511any later version. 512 513This program is distributed in the hope that it will be useful, but 514WITHOUT ANY WARRANTY; without even the implied warranty of 515MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 516General Public License for more details. 517 518You should have received a copy of the GNU General Public License 519along with this program; if not, see L<https://www.gnu.org/licenses/> 520or contact the Free Software Foundation, Inc., L<https://www.fsf.org>. 521 522=cut 523 524 525