line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# -*- encoding: utf-8; indent-tabs-mode: nil -*- |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Perl Date::Convert extension to convert dates from/to the French Revolutionary calendar |
4
|
|
|
|
|
|
|
# Copyright (C) 2001-2003, 2013 Jean Forget |
5
|
|
|
|
|
|
|
# |
6
|
|
|
|
|
|
|
# See the license in the embedded documentation below. |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
package Date::Convert::French_Rev; |
9
|
|
|
|
|
|
|
|
10
|
8
|
|
|
8
|
|
210638
|
use strict; |
|
8
|
|
|
|
|
20
|
|
|
8
|
|
|
|
|
320
|
|
11
|
8
|
|
|
8
|
|
40
|
use warnings; |
|
8
|
|
|
|
|
15
|
|
|
8
|
|
|
|
|
268
|
|
12
|
8
|
|
|
8
|
|
39
|
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK); |
|
8
|
|
|
|
|
17
|
|
|
8
|
|
|
|
|
754
|
|
13
|
8
|
|
|
8
|
|
15777
|
use Date::Convert; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Carp; |
15
|
|
|
|
|
|
|
use Roman; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
require Exporter; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
@ISA = qw(Date::Convert Exporter); |
20
|
|
|
|
|
|
|
# Do not export methods, therefore export nothing |
21
|
|
|
|
|
|
|
@EXPORT = qw( |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
); |
24
|
|
|
|
|
|
|
$VERSION = '0.06'; |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use constant REV_BEGINNING => 2375840; # 1 Vendémiaire I in the Revolutionary calendar |
27
|
|
|
|
|
|
|
my @MONTHS_SHORT = qw ( Vnd Bru Fri Niv Plu Vnt Ger Flo Pra Mes The Fru S-C); |
28
|
|
|
|
|
|
|
my @MONTHS = qw(Vendémiaire Brumaire Frimaire |
29
|
|
|
|
|
|
|
Nivôse Pluviôse Ventôse |
30
|
|
|
|
|
|
|
Germinal Floréal Prairial |
31
|
|
|
|
|
|
|
Messidor Thermidor Fructidor); |
32
|
|
|
|
|
|
|
push @MONTHS, "jour complémentaire"; # Incompatible with qw(), because of embedded space |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# The day numer 10 is counterintuitively placed in the 0-th element |
35
|
|
|
|
|
|
|
# because the modulus operator and the Perl arrays are 0-based. |
36
|
|
|
|
|
|
|
# It works. Do not report a bug. |
37
|
|
|
|
|
|
|
my @DECADE_DAYS = qw ( Décadi Primidi Duodi Tridi Quartidi Quintidi Sextidi Septidi Octidi Nonidi); |
38
|
|
|
|
|
|
|
my @DECADE_DAYS_SHORT = qw ( Déc Pri Duo Tri Qua Qui Sex Sep Oct Non); |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
# When initializing an array with lists within lists, it means one of two things: |
41
|
|
|
|
|
|
|
# Either it is a newbie who does not know how to make multi-dimensional arrays, |
42
|
|
|
|
|
|
|
# Or it is a (at least mildly) experienced Perl-coder who, for some reason, |
43
|
|
|
|
|
|
|
# wants to initialize a flat array with the concatenation of lists. |
44
|
|
|
|
|
|
|
# I am a (at least mildly) experienced programmer who wants to use qw() and yet insert |
45
|
|
|
|
|
|
|
# comments in some places. |
46
|
|
|
|
|
|
|
my @DAYS = ( |
47
|
|
|
|
|
|
|
# Vendémiaire |
48
|
|
|
|
|
|
|
qw( |
49
|
|
|
|
|
|
|
0raisin 0safran 1châtaigne 1colchique 0cheval |
50
|
|
|
|
|
|
|
1balsamine 1carotte 2amarante 0panais 1cuve |
51
|
|
|
|
|
|
|
1pomme_de_terre 2immortelle 0potiron 0réséda 2âne |
52
|
|
|
|
|
|
|
1belle_de_nuit 1citrouille 0sarrasin 0tournesol 0pressoir |
53
|
|
|
|
|
|
|
0chanvre 1pêche 0navet 2amaryllis 0bœuf |
54
|
|
|
|
|
|
|
2aubergine 0piment 1tomate 2orge 0tonneau |
55
|
|
|
|
|
|
|
), |
56
|
|
|
|
|
|
|
# Brumaire |
57
|
|
|
|
|
|
|
qw( |
58
|
|
|
|
|
|
|
1pomme 0céleri 1poire 1betterave 2oie |
59
|
|
|
|
|
|
|
2héliotrope 1figue 1scorsonère 2alisier 1charrue |
60
|
|
|
|
|
|
|
0salsifis 1macre 0topinambour 2endive 0dindon |
61
|
|
|
|
|
|
|
0chervis 0cresson 1dentelaire 1grenade 1herse |
62
|
|
|
|
|
|
|
1bacchante 2azerole 1garance 2orange 0faisan |
63
|
|
|
|
|
|
|
1pistache 0macjon 0coing 0cormier 0rouleau |
64
|
|
|
|
|
|
|
), |
65
|
|
|
|
|
|
|
# Frimaire |
66
|
|
|
|
|
|
|
qw( |
67
|
|
|
|
|
|
|
1raiponce 0turneps 1chicorée 1nèfle 0cochon |
68
|
|
|
|
|
|
|
1mâche 0chou-fleur 0miel 0genièvre 1pioche |
69
|
|
|
|
|
|
|
1cire 0raifort 0cèdre 0sapin 0chevreuil |
70
|
|
|
|
|
|
|
2ajonc 0cyprès 0lierre 1sabine 0hoyau |
71
|
|
|
|
|
|
|
2érable-sucre 1bruyère 0roseau 2oseille 0grillon |
72
|
|
|
|
|
|
|
0pignon 0liège 1truffe 2olive 1pelle |
73
|
|
|
|
|
|
|
), |
74
|
|
|
|
|
|
|
# Nivôse |
75
|
|
|
|
|
|
|
qw( |
76
|
|
|
|
|
|
|
1tourbe 1houille 0bitume 0soufre 0chien |
77
|
|
|
|
|
|
|
1lave 1terre_végétale 0fumier 0salpêtre 0fléau |
78
|
|
|
|
|
|
|
0granit 2argile 2ardoise 0grès 0lapin |
79
|
|
|
|
|
|
|
0silex 1marne 1pierre_à_chaux 0marbre 0van |
80
|
|
|
|
|
|
|
1pierre_à_plâtre 0sel 0fer 0cuivre 0chat |
81
|
|
|
|
|
|
|
2étain 0plomb 0zinc 0mercure 0crible |
82
|
|
|
|
|
|
|
), |
83
|
|
|
|
|
|
|
# Pluviôse |
84
|
|
|
|
|
|
|
qw( |
85
|
|
|
|
|
|
|
1lauréole 1mousse 0fragon 0perce-neige 0taureau |
86
|
|
|
|
|
|
|
0laurier-thym 2amadouvier 0mézéréon 0peuplier 1cognée |
87
|
|
|
|
|
|
|
2ellébore 0brocoli 0laurier 2avelinier 1vache |
88
|
|
|
|
|
|
|
0buis 0lichen 2if 1pulmonaire 1serpette |
89
|
|
|
|
|
|
|
0thlaspi 0thymelé 0chiendent 1traînasse 0lièvre |
90
|
|
|
|
|
|
|
1guède 0noisetier 0cyclamen 1chélidoine 0traîneau |
91
|
|
|
|
|
|
|
), |
92
|
|
|
|
|
|
|
# Ventôse |
93
|
|
|
|
|
|
|
qw( |
94
|
|
|
|
|
|
|
0tussilage 0cornouiller 0violier 0troène 0bouc |
95
|
|
|
|
|
|
|
2asaret 2alaterne 1violette 0marsault 1bêche |
96
|
|
|
|
|
|
|
0narcisse 2orme 1fumeterre 0vélar 1chèvre |
97
|
|
|
|
|
|
|
2épinard 0doronic 0mouron 0cerfeuil 0cordeau |
98
|
|
|
|
|
|
|
1mandragore 0persil 0cochléaria 1pâquerette 0thon |
99
|
|
|
|
|
|
|
0pissenlit 1sylvie 0capillaire 0frêne 0plantoir |
100
|
|
|
|
|
|
|
), |
101
|
|
|
|
|
|
|
# Germinal |
102
|
|
|
|
|
|
|
qw( |
103
|
|
|
|
|
|
|
1primevère 0platane 2asperge 1tulipe 1poule |
104
|
|
|
|
|
|
|
1blette 0bouleau 1jonquille 2aulne 0couvoir |
105
|
|
|
|
|
|
|
1pervenche 0charme 1morille 0hêtre 2abeille |
106
|
|
|
|
|
|
|
1laitue 0mélèze 1ciguë 0radis 1ruche |
107
|
|
|
|
|
|
|
0gainier 1romaine 0marronnier 1roquette 0pigeon |
108
|
|
|
|
|
|
|
0lilas 2anémone 1pensée 1myrtille 0greffoir |
109
|
|
|
|
|
|
|
), |
110
|
|
|
|
|
|
|
# Floréal |
111
|
|
|
|
|
|
|
qw( |
112
|
|
|
|
|
|
|
1rose 0chêne 1fougère 2aubépine 0rossignol |
113
|
|
|
|
|
|
|
2ancolie 0muguet 0champignon 1jacinthe 0rateau |
114
|
|
|
|
|
|
|
1rhubarbe 0sainfoin 0bâton-d'or 0chamérisier 0ver_à_soie |
115
|
|
|
|
|
|
|
1consoude 1pimprenelle 1corbeille-d'or 2arroche 0sarcloir |
116
|
|
|
|
|
|
|
0statice 1fritillaire 1bourrache 1valériane 1carpe |
117
|
|
|
|
|
|
|
0fusain 1civette 1buglosse 0sénevé 1houlette |
118
|
|
|
|
|
|
|
), |
119
|
|
|
|
|
|
|
# Prairial |
120
|
|
|
|
|
|
|
qw( |
121
|
|
|
|
|
|
|
1luzerne 2hémérocalle 0trèfle 2angélique 0canard |
122
|
|
|
|
|
|
|
1mélisse 0fromental 0martagon 0serpolet 1faux |
123
|
|
|
|
|
|
|
1fraise 1bétoine 0pois 2acacia 1caille |
124
|
|
|
|
|
|
|
2œillet 0sureau 0pavot 0tilleul 1fourche |
125
|
|
|
|
|
|
|
0barbeau 1camomille 0chèvrefeuille 0caille-lait 1tanche |
126
|
|
|
|
|
|
|
0jasmin 1verveine 0thym 1pivoine 0chariot |
127
|
|
|
|
|
|
|
), |
128
|
|
|
|
|
|
|
# Messidor |
129
|
|
|
|
|
|
|
qw( |
130
|
|
|
|
|
|
|
0seigle 2avoine 2oignon 1véronique 0mulet |
131
|
|
|
|
|
|
|
0romarin 0concombre 2échalotte 2absinthe 1faucille |
132
|
|
|
|
|
|
|
1coriandre 2artichaut 1giroflée 1lavande 0chamois |
133
|
|
|
|
|
|
|
0tabac 1groseille 1gesse 1cerise 0parc |
134
|
|
|
|
|
|
|
1menthe 0cumin 0haricot 2orcanète 1pintade |
135
|
|
|
|
|
|
|
1sauge 2ail 1vesce 0blé 1chalémie |
136
|
|
|
|
|
|
|
), |
137
|
|
|
|
|
|
|
# Thermidor |
138
|
|
|
|
|
|
|
qw( |
139
|
|
|
|
|
|
|
2épautre 0bouillon-blanc 0melon 2ivraie 0bélier |
140
|
|
|
|
|
|
|
1prèle 2armoise 0carthame 1mûre 2arrosoir |
141
|
|
|
|
|
|
|
0panis 0salicor 2abricot 0basilic 1brebis |
142
|
|
|
|
|
|
|
1guimauve 0lin 2amande 1gentiane 2écluse |
143
|
|
|
|
|
|
|
1carline 0câprier 1lentille 2aunée 1loutre |
144
|
|
|
|
|
|
|
1myrte 0colza 0lupin 0coton 0moulin |
145
|
|
|
|
|
|
|
), |
146
|
|
|
|
|
|
|
# Fructidor |
147
|
|
|
|
|
|
|
qw( |
148
|
|
|
|
|
|
|
1prune 0millet 0lycoperdon 2escourgeon 0saumon |
149
|
|
|
|
|
|
|
1tubéreuse 0sucrion 2apocyn 1réglisse 2échelle |
150
|
|
|
|
|
|
|
1pastèque 0fenouil 2épine-vinette 1noix 1truite |
151
|
|
|
|
|
|
|
0citron 1cardère 0nerprun 0tagette 1hotte |
152
|
|
|
|
|
|
|
2églantier 1noisette 0houblon 0sorgho 2écrevisse |
153
|
|
|
|
|
|
|
1bagarade 1verge-d'or 0maïs 0marron 0panier |
154
|
|
|
|
|
|
|
), |
155
|
|
|
|
|
|
|
# Jours complémentaires |
156
|
|
|
|
|
|
|
qw( |
157
|
|
|
|
|
|
|
1vertu 0génie 0travail 2opinion 3récompenses |
158
|
|
|
|
|
|
|
1révolution |
159
|
|
|
|
|
|
|
)); |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
my @PREFIXES = ('jour du ', 'jour de la ', "jour de l'", 'jour des '); |
162
|
|
|
|
|
|
|
|
163
|
|
|
|
|
|
|
use constant NORMAL_YEAR => 365; |
164
|
|
|
|
|
|
|
use constant LEAP_YEAR => 366; |
165
|
|
|
|
|
|
|
use constant FOUR_YEARS => 4 * NORMAL_YEAR + 1; # one leap year every four years |
166
|
|
|
|
|
|
|
use constant CENTURY => 25 * FOUR_YEARS - 1; # centuries aren't leap years... |
167
|
|
|
|
|
|
|
use constant FOUR_CENTURIES => 4 * CENTURY + 1; # ...except every four centuries that are. |
168
|
|
|
|
|
|
|
use constant FOUR_MILLENIA => 10 * FOUR_CENTURIES - 1; # ...except every four millenia that are not. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
# number of days between the start of the revolutionary calendar, and the |
171
|
|
|
|
|
|
|
# beginning of year n - 1 |
172
|
|
|
|
|
|
|
my @YEARS_BEGINS= (0, 365, 730, 1096, 1461, 1826, 2191, 2557, 2922, 3287, 3652, |
173
|
|
|
|
|
|
|
4018, 4383, 4748, 5113, 5479, 5844); |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
sub initialize { |
176
|
|
|
|
|
|
|
my $self = shift; |
177
|
|
|
|
|
|
|
my ($year, $month, $day) = @_; |
178
|
|
|
|
|
|
|
unless (defined($year) and defined($month) and defined($day)) |
179
|
|
|
|
|
|
|
{ croak "Date::Convert::French_Rev::initialize needs more args" } |
180
|
|
|
|
|
|
|
my $absol = REV_BEGINNING; |
181
|
|
|
|
|
|
|
$$self{'year'} = $year; |
182
|
|
|
|
|
|
|
$$self{'month'} = $month; |
183
|
|
|
|
|
|
|
$$self{'day'} = $day; |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
my $is_leap = Date::Convert::French_Rev->is_leap($year); |
186
|
|
|
|
|
|
|
croak "year $year out of range" if $year <= 0; |
187
|
|
|
|
|
|
|
croak "month $month out of range" if $month > 13 or $month <= 0; |
188
|
|
|
|
|
|
|
croak "standard day number $day out of range" if $day <= 0 and $month <= 12; |
189
|
|
|
|
|
|
|
croak "standard day number $day out of range" if $day > 30 and $month <= 12; |
190
|
|
|
|
|
|
|
croak "additional day $day out of range" if ($month == 13) and ($day <= 0); |
191
|
|
|
|
|
|
|
croak "additional day $day out of range" if ($month == 13) and ($day > 5) and !$is_leap; |
192
|
|
|
|
|
|
|
croak "additional day $day out of range" if ($month == 13) and ($day > 6); # implying "and $is_leap" other cases already discarded |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
$year --; #get years *before* this year. Makes math easier. :) |
195
|
|
|
|
|
|
|
# first, convert year into days. . . |
196
|
|
|
|
|
|
|
if ($year >= 16) # Romme rule in effect, or nearly so |
197
|
|
|
|
|
|
|
{ |
198
|
|
|
|
|
|
|
$absol += int($year/4000) * FOUR_MILLENIA; |
199
|
|
|
|
|
|
|
$year %= 4000; |
200
|
|
|
|
|
|
|
$absol += int($year/400) * FOUR_CENTURIES; |
201
|
|
|
|
|
|
|
$year %= 400; |
202
|
|
|
|
|
|
|
$absol += int($year/100) * CENTURY; |
203
|
|
|
|
|
|
|
$year %= 100; |
204
|
|
|
|
|
|
|
$absol += int($year/4)* FOUR_YEARS; |
205
|
|
|
|
|
|
|
$year %= 4; |
206
|
|
|
|
|
|
|
$absol += $year * NORMAL_YEAR; |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
else # table look-up for the programmer-hostile equinox rule |
209
|
|
|
|
|
|
|
{ $absol += $YEARS_BEGINS[$year] } |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
# now, month into days. |
212
|
|
|
|
|
|
|
$absol += 30 * ($month - 1) + $day - 1; |
213
|
|
|
|
|
|
|
|
214
|
|
|
|
|
|
|
$$self{absol} = $absol; |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
sub year { |
218
|
|
|
|
|
|
|
my $self = shift; |
219
|
|
|
|
|
|
|
return $$self{year} if exists $$self{year}; # no point recalculating. |
220
|
|
|
|
|
|
|
my $days; |
221
|
|
|
|
|
|
|
my $year; |
222
|
|
|
|
|
|
|
# note: years and days are initially days *before* today, rather than |
223
|
|
|
|
|
|
|
# today's date. This is because of fenceposts. :) |
224
|
|
|
|
|
|
|
$days = $$self{absol} - REV_BEGINNING; |
225
|
|
|
|
|
|
|
if ($days < $YEARS_BEGINS[16]) { |
226
|
|
|
|
|
|
|
$year = scalar grep { $_ <= $days } @YEARS_BEGINS; |
227
|
|
|
|
|
|
|
$days -= $YEARS_BEGINS[$year - 1]; |
228
|
|
|
|
|
|
|
$days++; |
229
|
|
|
|
|
|
|
} |
230
|
|
|
|
|
|
|
else { |
231
|
|
|
|
|
|
|
my $x; |
232
|
|
|
|
|
|
|
$x = int ($days / FOUR_MILLENIA); |
233
|
|
|
|
|
|
|
$year += $x * 4000; |
234
|
|
|
|
|
|
|
$days -= $x * FOUR_MILLENIA; |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
$x = int ($days / FOUR_CENTURIES); |
237
|
|
|
|
|
|
|
$year += $x * 400; |
238
|
|
|
|
|
|
|
$days -= $x * FOUR_CENTURIES; |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
$x = int ($days / CENTURY); |
241
|
|
|
|
|
|
|
$x = 3 if $x == 4; # last day of the 400-year period |
242
|
|
|
|
|
|
|
$year += $x * 100; |
243
|
|
|
|
|
|
|
$days -= $x * CENTURY; |
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
$x = int ($days / FOUR_YEARS); |
246
|
|
|
|
|
|
|
$year += $x * 4; |
247
|
|
|
|
|
|
|
$days -= $x * FOUR_YEARS; |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
$x = int ($days / NORMAL_YEAR); |
250
|
|
|
|
|
|
|
$x = 3 if $x == 4; # last day of the 4-year period |
251
|
|
|
|
|
|
|
$year += $x; |
252
|
|
|
|
|
|
|
$days -= $x * NORMAL_YEAR; |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
++$year; # because of 0-based mathematics vs 1-based chronology |
255
|
|
|
|
|
|
|
++$days; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
$$self{year} = $year; |
258
|
|
|
|
|
|
|
$$self{days_into_year} = $days; |
259
|
|
|
|
|
|
|
return $year; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
sub month { |
263
|
|
|
|
|
|
|
my $self = shift; |
264
|
|
|
|
|
|
|
return $$self{month} if exists $$self{month}; |
265
|
|
|
|
|
|
|
my $year = $self -> year; |
266
|
|
|
|
|
|
|
my $days = $$self{days_into_year} - 1; |
267
|
|
|
|
|
|
|
my $day = $days % 30; |
268
|
|
|
|
|
|
|
$days -= $day; |
269
|
|
|
|
|
|
|
my $month = $days / 30 + 1; |
270
|
|
|
|
|
|
|
$$self{month} = $month; |
271
|
|
|
|
|
|
|
$$self{day} = $day + 1; |
272
|
|
|
|
|
|
|
return $month; |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub day { |
276
|
|
|
|
|
|
|
my $self = shift; |
277
|
|
|
|
|
|
|
return $$self{day} if exists $$self{day}; |
278
|
|
|
|
|
|
|
$self->month; # calculates day as a side-effect |
279
|
|
|
|
|
|
|
return $$self{day}; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub date { |
283
|
|
|
|
|
|
|
my $self = shift; |
284
|
|
|
|
|
|
|
return ($self->year, $self->month, $self->day); |
285
|
|
|
|
|
|
|
} |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
sub is_leap { |
288
|
|
|
|
|
|
|
my ($self, $year) = @_; |
289
|
|
|
|
|
|
|
if (@_ == 1) { |
290
|
|
|
|
|
|
|
$year = $self->year; # so is_leap can be static or method |
291
|
|
|
|
|
|
|
} |
292
|
|
|
|
|
|
|
|
293
|
|
|
|
|
|
|
# Autumn equinox from I to XIX |
294
|
|
|
|
|
|
|
return 1 if ($year == 3) or ($year == 7) or ($year == 11) or ($year == 15); |
295
|
|
|
|
|
|
|
return 0 if ($year < 20); |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# Romme rule from XX on |
298
|
|
|
|
|
|
|
return 0 if $year % 4; # not a multiple of 4 -> normal year |
299
|
|
|
|
|
|
|
return 1 if $year % 100; # a multiple of 4 but not of 100 -> leap year |
300
|
|
|
|
|
|
|
return 0 if $year % 400; # a multiple of 100 but not of 400 -> normal year |
301
|
|
|
|
|
|
|
return 1 if $year % 4000; # a multiple of 400 but not of 4000 -> leap |
302
|
|
|
|
|
|
|
return 0; # multiple of 4000 -> normal year |
303
|
|
|
|
|
|
|
} |
304
|
|
|
|
|
|
|
|
305
|
|
|
|
|
|
|
sub field { |
306
|
|
|
|
|
|
|
my ($self, $spec) = @_; |
307
|
|
|
|
|
|
|
my $decade_day = $self->day % 10; |
308
|
|
|
|
|
|
|
# below, a switch statement, more or less, as described in perlfaq7 |
309
|
|
|
|
|
|
|
|
310
|
|
|
|
|
|
|
$spec eq '%d' && do { return sprintf "%02d", $self->day }; |
311
|
|
|
|
|
|
|
$spec eq '%j' && do { return sprintf "%03d", 30 * $self->month + $self->day - 30 }; |
312
|
|
|
|
|
|
|
$spec eq '%e' && do { return sprintf "%2d", $self->day }; |
313
|
|
|
|
|
|
|
$spec eq '%m' && do { return sprintf "%02d", $self->month }; |
314
|
|
|
|
|
|
|
$spec eq '%f' && do { return sprintf "%2d", $self->month }; |
315
|
|
|
|
|
|
|
$spec =~ /\%[YGL]/ && do { return sprintf "%04d", $self->year }; |
316
|
|
|
|
|
|
|
$spec =~ /\%B/ && do { return $MONTHS[$self->month - 1] }; |
317
|
|
|
|
|
|
|
$spec =~ /\%[bh]/ && do { return $MONTHS_SHORT[$self->month - 1] }; |
318
|
|
|
|
|
|
|
$spec eq '%y' && do { return sprintf "%02d", $self->year % 100 }; |
319
|
|
|
|
|
|
|
$spec eq '%n' && do { return "\n" }; |
320
|
|
|
|
|
|
|
$spec eq '%t' && do { return "\t" }; |
321
|
|
|
|
|
|
|
$spec eq '%+' && do { return '+' }; |
322
|
|
|
|
|
|
|
$spec eq '%%' && do { return '%' }; |
323
|
|
|
|
|
|
|
$spec eq '%a' && do { return $DECADE_DAYS_SHORT[$decade_day] }; |
324
|
|
|
|
|
|
|
$spec eq '%A' && do { return $DECADE_DAYS[$decade_day] }; |
325
|
|
|
|
|
|
|
$spec eq '%w' && do { return sprintf("%2d", $decade_day || 10) }; |
326
|
|
|
|
|
|
|
$spec eq '%EY' && do { return $self->year < 4000 ? Roman($self->year) : $self->year }; |
327
|
|
|
|
|
|
|
$spec eq '%Ey' && do { return $self->year < 4000 ? roman($self->year) : $self->year }; |
328
|
|
|
|
|
|
|
($spec eq '%Ej' || $spec eq '%*') |
329
|
|
|
|
|
|
|
&& do |
330
|
|
|
|
|
|
|
{ |
331
|
|
|
|
|
|
|
my $jj = 30 * $self->month + $self->day - 31; # %j is 1..366, but $jj is 0..365 |
332
|
|
|
|
|
|
|
my $lb = $DAYS[$jj]; |
333
|
|
|
|
|
|
|
$lb =~ s/_/ /g; |
334
|
|
|
|
|
|
|
$lb =~ s/^(\d)/$PREFIXES[$1 % 4]/; |
335
|
|
|
|
|
|
|
return $lb; |
336
|
|
|
|
|
|
|
}; |
337
|
|
|
|
|
|
|
$spec eq '%EJ' && do |
338
|
|
|
|
|
|
|
{ |
339
|
|
|
|
|
|
|
my $jj = 30 * $self->month + $self->day - 31; # %j is 1..366, but $jj is 0..365 |
340
|
|
|
|
|
|
|
my $lb = $DAYS[$jj]; |
341
|
|
|
|
|
|
|
$lb =~ s/_/ /g; |
342
|
|
|
|
|
|
|
# Using a capitalized prefix, and capitalizing the first letter |
343
|
|
|
|
|
|
|
$lb =~ s/^(\d)(.)/\u$PREFIXES[$1 % 4]\u$2/; |
344
|
|
|
|
|
|
|
return $lb; |
345
|
|
|
|
|
|
|
}; |
346
|
|
|
|
|
|
|
$spec eq '%Oj' && do |
347
|
|
|
|
|
|
|
{ |
348
|
|
|
|
|
|
|
my $jj = 30 * $self->month + $self->day - 31; # %j is 1..366, but $jj is 0..365 |
349
|
|
|
|
|
|
|
my $lb = substr $DAYS[$jj], 1; |
350
|
|
|
|
|
|
|
$lb =~ s/_/ /g; |
351
|
|
|
|
|
|
|
return $lb; |
352
|
|
|
|
|
|
|
}; |
353
|
|
|
|
|
|
|
return $spec; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
|
356
|
|
|
|
|
|
|
sub date_string { |
357
|
|
|
|
|
|
|
my ($self, $format) = @_; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
# Default value when not provided. I do not test true / false, because |
360
|
|
|
|
|
|
|
# some adventurous mind could think that "0" is a valid format, even if false. |
361
|
|
|
|
|
|
|
$format = "%e %B %EY" if (! defined $format or $format eq ''); |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
my $year = $self->year; # possibly to trigger the side effect |
364
|
|
|
|
|
|
|
my $month = $self->month; |
365
|
|
|
|
|
|
|
$format =~ s/( # start of $1 |
366
|
|
|
|
|
|
|
\% # percent sign |
367
|
|
|
|
|
|
|
(?: # start of alternative |
368
|
|
|
|
|
|
|
(?:O.) # extended field specifier: O with a second char |
369
|
|
|
|
|
|
|
| # or |
370
|
|
|
|
|
|
|
(?:E.) # other extended field specifier: E with a second char |
371
|
|
|
|
|
|
|
| # or |
372
|
|
|
|
|
|
|
. # basic field specifier: single char |
373
|
|
|
|
|
|
|
)) # end of alternative and end of $1 |
374
|
|
|
|
|
|
|
/'$self->field($1)'/eegx; # is there a simpler way to do it? |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
return $format; |
377
|
|
|
|
|
|
|
} |
378
|
|
|
|
|
|
|
|
379
|
|
|
|
|
|
|
# A module must return a true value. Traditionally, a module returns 1. |
380
|
|
|
|
|
|
|
# But this module is a revolutionary one, so it discards all old traditions. |
381
|
|
|
|
|
|
|
"Liberté, égalité, fraternité |
382
|
|
|
|
|
|
|
ou la mort !"; |
383
|
|
|
|
|
|
|
|
384
|
|
|
|
|
|
|
__END__ |