line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package DateTime::Fiction::JRRTolkien::Shire; |
2
|
|
|
|
|
|
|
|
3
|
9
|
|
|
9
|
|
3680869
|
use 5.008004; |
|
9
|
|
|
|
|
97
|
|
4
|
|
|
|
|
|
|
|
5
|
9
|
|
|
9
|
|
62
|
use strict; |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
231
|
|
6
|
9
|
|
|
9
|
|
79
|
use warnings; |
|
9
|
|
|
|
|
23
|
|
|
9
|
|
|
|
|
335
|
|
7
|
|
|
|
|
|
|
|
8
|
9
|
|
|
9
|
|
57
|
use Carp (); |
|
9
|
|
|
|
|
19
|
|
|
9
|
|
|
|
|
422
|
|
9
|
9
|
|
|
|
|
1880
|
use Date::Tolkien::Shire::Data 0.001 qw{ |
10
|
|
|
|
|
|
|
__date_to_day_of_year |
11
|
|
|
|
|
|
|
__day_of_week |
12
|
|
|
|
|
|
|
__day_of_year_to_date |
13
|
|
|
|
|
|
|
__format |
14
|
|
|
|
|
|
|
__holiday_name __holiday_abbr |
15
|
|
|
|
|
|
|
__holiday_name_to_number |
16
|
|
|
|
|
|
|
__is_leap_year |
17
|
|
|
|
|
|
|
__month_name __month_abbr |
18
|
|
|
|
|
|
|
__month_name_to_number |
19
|
|
|
|
|
|
|
__quarter __quarter_name __quarter_abbr |
20
|
|
|
|
|
|
|
__rata_die_to_year_day |
21
|
|
|
|
|
|
|
__trad_weekday_name __trad_weekday_abbr |
22
|
|
|
|
|
|
|
__week_of_year |
23
|
|
|
|
|
|
|
__weekday_name __weekday_abbr |
24
|
|
|
|
|
|
|
__year_day_to_rata_die |
25
|
|
|
|
|
|
|
GREGORIAN_RATA_DIE_TO_SHIRE |
26
|
9
|
|
|
9
|
|
6043
|
}; |
|
9
|
|
|
|
|
354045
|
|
27
|
9
|
|
|
9
|
|
2069
|
use DateTime 0.14; |
|
9
|
|
|
|
|
1002010
|
|
|
9
|
|
|
|
|
291
|
|
28
|
9
|
|
|
9
|
|
5233
|
use DateTime::Fiction::JRRTolkien::Shire::Duration; |
|
9
|
|
|
|
|
36
|
|
|
9
|
|
|
|
|
362
|
|
29
|
9
|
|
|
9
|
|
77
|
use DateTime::Fiction::JRRTolkien::Shire::Types (); |
|
9
|
|
|
|
|
24
|
|
|
9
|
|
|
|
|
210
|
|
30
|
9
|
|
|
9
|
|
51
|
use Params::ValidationCompiler 0.13 (); |
|
9
|
|
|
|
|
169
|
|
|
9
|
|
|
|
|
571
|
|
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# This Conan The Barbarian-style import is because I am reluctant to use |
33
|
|
|
|
|
|
|
# any magic more subtle than I myself posess; to wit |
34
|
|
|
|
|
|
|
# namespace::autoclean. |
35
|
|
|
|
|
|
|
*__t = \&DateTime::Fiction::JRRTolkien::Shire::Types::t; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
our $VERSION = '0.906'; |
38
|
|
|
|
|
|
|
|
39
|
9
|
|
|
9
|
|
69
|
use constant DAY_NUMBER_MIDYEARS_DAY => 183; |
|
9
|
|
|
|
|
20
|
|
|
9
|
|
|
|
|
824
|
|
40
|
|
|
|
|
|
|
|
41
|
9
|
|
|
9
|
|
66
|
use constant HASH_REF => ref {}; |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
8193
|
|
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
my @delegate_to_dt = qw( hour minute second nanosecond locale ); |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
# This assumes all the values in the info hashref are valid, and doesn't |
46
|
|
|
|
|
|
|
# do validation However, the day and month parameters will be given |
47
|
|
|
|
|
|
|
# defaults if not present |
48
|
|
|
|
|
|
|
sub _recalc_DateTime { |
49
|
68
|
|
|
68
|
|
210
|
my ($self, %dt_args) = @_; |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
my $shire_rd = __year_day_to_rata_die( |
52
|
|
|
|
|
|
|
$self->{year}, |
53
|
|
|
|
|
|
|
__date_to_day_of_year( |
54
|
|
|
|
|
|
|
$self->{year}, |
55
|
|
|
|
|
|
|
$self->{month}, |
56
|
|
|
|
|
|
|
$self->{day} || $self->{holiday}, |
57
|
68
|
|
66
|
|
|
598
|
), |
58
|
|
|
|
|
|
|
); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Because the leap year algorithm is the same in both calendars, I |
61
|
|
|
|
|
|
|
# can use __rata_die_to_year_day() on the Gregorian Rata Die day. |
62
|
68
|
|
|
|
|
7851
|
( $dt_args{year}, $dt_args{day_of_year} ) = __rata_die_to_year_day( |
63
|
|
|
|
|
|
|
$shire_rd - GREGORIAN_RATA_DIE_TO_SHIRE ); |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# We may be calling this because we have fiddled with the Shire date |
66
|
|
|
|
|
|
|
# and need to preserve stuff that is maintained by the embedded |
67
|
|
|
|
|
|
|
# DateTime object. So if we actually have said object, preserve |
68
|
|
|
|
|
|
|
# everything not explicitly specified. |
69
|
68
|
100
|
|
|
|
5175
|
if ( $self->{dt} ) { |
70
|
10
|
|
|
|
|
65
|
foreach my $name ( @delegate_to_dt ) { |
71
|
|
|
|
|
|
|
defined $dt_args{$name} |
72
|
50
|
100
|
|
|
|
249
|
or $dt_args{$name} = $self->{dt}->$name(); |
73
|
|
|
|
|
|
|
} |
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
68
|
|
|
|
|
405
|
$self->{dt} = DateTime->from_day_of_year( %dt_args ); |
77
|
|
|
|
|
|
|
|
78
|
68
|
|
|
|
|
23577
|
return; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub _recalc_Shire { |
82
|
41
|
|
|
41
|
|
89
|
my ( $self ) = @_; |
83
|
|
|
|
|
|
|
|
84
|
41
|
|
|
|
|
137
|
my $greg_rd = ( $self->local_rd_values() )[0]; |
85
|
|
|
|
|
|
|
|
86
|
41
|
|
|
|
|
368
|
my ( $year, $day_of_year ) = __rata_die_to_year_day( |
87
|
|
|
|
|
|
|
$greg_rd + GREGORIAN_RATA_DIE_TO_SHIRE ); |
88
|
|
|
|
|
|
|
|
89
|
41
|
|
|
|
|
3511
|
my ( $month, $day ) = __day_of_year_to_date( $year, $day_of_year ); |
90
|
|
|
|
|
|
|
|
91
|
41
|
|
|
|
|
3046
|
$self->{year} = $year; |
92
|
41
|
|
|
|
|
107
|
$self->{leapyear} = __is_leap_year( $year ); |
93
|
41
|
|
|
|
|
1015
|
$self->{wday} = __day_of_week( $month, $day ); |
94
|
41
|
100
|
|
|
|
1468
|
if ( $month ) { |
95
|
32
|
|
|
|
|
73
|
$self->{month} = $month; |
96
|
32
|
|
|
|
|
52
|
$self->{day} = $day; |
97
|
32
|
|
|
|
|
67
|
$self->{holiday} = 0; |
98
|
|
|
|
|
|
|
} else { |
99
|
9
|
|
|
|
|
21
|
$self->{holiday} = $day; |
100
|
9
|
|
|
|
|
22
|
$self->{month} = $self->{day} = 0; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
41
|
|
|
|
|
80
|
$self->{recalc} = 0; |
104
|
|
|
|
|
|
|
|
105
|
41
|
|
|
|
|
101
|
return; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
# Constructors |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
{ |
111
|
|
|
|
|
|
|
my $validator = Params::ValidationCompiler::validation_for( |
112
|
|
|
|
|
|
|
name => '_validation_for_new', |
113
|
|
|
|
|
|
|
name_is_optional => 1, |
114
|
|
|
|
|
|
|
params => { |
115
|
|
|
|
|
|
|
year => { |
116
|
|
|
|
|
|
|
type => __t( 'Year' ), |
117
|
|
|
|
|
|
|
}, |
118
|
|
|
|
|
|
|
month => { |
119
|
|
|
|
|
|
|
type => __t( 'Month' ), |
120
|
|
|
|
|
|
|
optional => 1, |
121
|
|
|
|
|
|
|
}, |
122
|
|
|
|
|
|
|
day => { |
123
|
|
|
|
|
|
|
type => __t( 'DayOfMonth' ), |
124
|
|
|
|
|
|
|
optional => 1, |
125
|
|
|
|
|
|
|
}, |
126
|
|
|
|
|
|
|
holiday => { |
127
|
|
|
|
|
|
|
type => __t( 'Holiday' ), |
128
|
|
|
|
|
|
|
optional => 1, |
129
|
|
|
|
|
|
|
}, |
130
|
|
|
|
|
|
|
hour => { |
131
|
|
|
|
|
|
|
type => __t( 'Hour' ), |
132
|
|
|
|
|
|
|
default => 0, |
133
|
|
|
|
|
|
|
}, |
134
|
|
|
|
|
|
|
minute => { |
135
|
|
|
|
|
|
|
type => __t( 'Minute' ), |
136
|
|
|
|
|
|
|
default => 0, |
137
|
|
|
|
|
|
|
}, |
138
|
|
|
|
|
|
|
second => { |
139
|
|
|
|
|
|
|
type => __t( 'Second' ), |
140
|
|
|
|
|
|
|
default => 0, |
141
|
|
|
|
|
|
|
}, |
142
|
|
|
|
|
|
|
nanosecond => { |
143
|
|
|
|
|
|
|
type => __t( 'Nanosecond' ), |
144
|
|
|
|
|
|
|
default => 0, |
145
|
|
|
|
|
|
|
}, |
146
|
|
|
|
|
|
|
time_zone => { |
147
|
|
|
|
|
|
|
type => __t( 'TimeZone' ), |
148
|
|
|
|
|
|
|
optional => 1, |
149
|
|
|
|
|
|
|
}, |
150
|
|
|
|
|
|
|
locale => { |
151
|
|
|
|
|
|
|
type => __t( 'Locale' ), |
152
|
|
|
|
|
|
|
optional => 1, |
153
|
|
|
|
|
|
|
}, |
154
|
|
|
|
|
|
|
formatter => { |
155
|
|
|
|
|
|
|
type => __t( 'Formatter' ), |
156
|
|
|
|
|
|
|
optional => 1, |
157
|
|
|
|
|
|
|
}, |
158
|
|
|
|
|
|
|
accented => { |
159
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
160
|
|
|
|
|
|
|
optional => 1, |
161
|
|
|
|
|
|
|
}, |
162
|
|
|
|
|
|
|
traditional => { |
163
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
164
|
|
|
|
|
|
|
optional => 1, |
165
|
|
|
|
|
|
|
}, |
166
|
|
|
|
|
|
|
}, |
167
|
|
|
|
|
|
|
); |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
sub new { |
170
|
57
|
|
|
57
|
1
|
34981
|
my ( $class, @args ) = @_; |
171
|
|
|
|
|
|
|
|
172
|
57
|
|
|
|
|
1442
|
my %my_arg = $validator->( @args ); |
173
|
|
|
|
|
|
|
|
174
|
57
|
|
|
|
|
9775
|
_check_date( \%my_arg ); |
175
|
|
|
|
|
|
|
|
176
|
57
|
|
|
|
|
235
|
return $class->_new( %my_arg ); |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
} |
179
|
|
|
|
|
|
|
|
180
|
|
|
|
|
|
|
# For internal use only - no validation. |
181
|
|
|
|
|
|
|
sub _new { |
182
|
58
|
|
|
58
|
|
216
|
my ( $class, %my_arg ) = @_; |
183
|
|
|
|
|
|
|
|
184
|
58
|
100
|
|
|
|
171
|
if ( $my_arg{month} ) { |
185
|
39
|
|
|
|
|
162
|
$my_arg{month} = __month_name_to_number( $my_arg{month} ); |
186
|
39
|
|
100
|
|
|
1763
|
$my_arg{day} ||= 1; |
187
|
39
|
|
|
|
|
122
|
$my_arg{holiday} = 0; |
188
|
|
|
|
|
|
|
} else { |
189
|
19
|
|
0
|
|
|
54
|
$my_arg{holiday} ||= $my_arg{day} || 1; |
|
|
|
33
|
|
|
|
|
190
|
|
|
|
|
|
|
$my_arg{holiday} = __holiday_name_to_number( |
191
|
19
|
|
|
|
|
73
|
$my_arg{holiday} ); |
192
|
19
|
|
|
|
|
800
|
$my_arg{month} = $my_arg{day} = 0; |
193
|
|
|
|
|
|
|
} |
194
|
58
|
|
|
|
|
179
|
$my_arg{leapyear} = __is_leap_year( $my_arg{year} ); |
195
|
|
|
|
|
|
|
$my_arg{wday} = __day_of_week( |
196
|
|
|
|
|
|
|
$my_arg{month}, |
197
|
|
|
|
|
|
|
$my_arg{day} || $my_arg{holiday}, |
198
|
58
|
|
66
|
|
|
1702
|
); |
199
|
|
|
|
|
|
|
|
200
|
58
|
|
|
|
|
2163
|
my %dt_arg; |
201
|
58
|
|
|
|
|
137
|
foreach my $key ( @delegate_to_dt ) { |
202
|
|
|
|
|
|
|
defined $my_arg{$key} |
203
|
290
|
100
|
|
|
|
850
|
and $dt_arg{$key} = delete $my_arg{$key}; |
204
|
|
|
|
|
|
|
} |
205
|
|
|
|
|
|
|
|
206
|
58
|
|
|
|
|
142
|
my $self = bless \%my_arg, $class; |
207
|
|
|
|
|
|
|
|
208
|
58
|
|
|
|
|
255
|
$self->_recalc_DateTime(%dt_arg); |
209
|
|
|
|
|
|
|
|
210
|
58
|
|
|
|
|
340
|
return $self; |
211
|
|
|
|
|
|
|
} |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
{ |
214
|
|
|
|
|
|
|
my $validator = Params::ValidationCompiler::validation_for( |
215
|
|
|
|
|
|
|
name => '_validation_for_output_options', |
216
|
|
|
|
|
|
|
name_is_optional => 1, |
217
|
|
|
|
|
|
|
params => { |
218
|
|
|
|
|
|
|
accented => { |
219
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
220
|
|
|
|
|
|
|
optional => 1, |
221
|
|
|
|
|
|
|
}, |
222
|
|
|
|
|
|
|
traditional => { |
223
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
224
|
|
|
|
|
|
|
optional => 1, |
225
|
|
|
|
|
|
|
}, |
226
|
|
|
|
|
|
|
}, |
227
|
|
|
|
|
|
|
); |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
# sub from_epoch; sub now; sub today; |
230
|
|
|
|
|
|
|
foreach my $method ( qw{ from_epoch now today } ) { |
231
|
9
|
|
|
9
|
|
110
|
no strict qw{ refs }; |
|
9
|
|
|
|
|
22
|
|
|
9
|
|
|
|
|
26397
|
|
232
|
|
|
|
|
|
|
*$method = sub { |
233
|
7
|
|
|
7
|
|
2014
|
my ( $class, %arg ) = @_; |
234
|
|
|
|
|
|
|
|
235
|
7
|
|
|
|
|
19
|
my %my_arg; |
236
|
|
|
|
|
|
|
exists $my_arg{$_} and $my_arg{$_} = delete $arg{$_} |
237
|
7
|
|
33
|
|
|
46
|
for qw{ accented traditional }; |
238
|
|
|
|
|
|
|
|
239
|
7
|
|
|
|
|
187
|
%my_arg = $validator->( %my_arg ); |
240
|
|
|
|
|
|
|
|
241
|
7
|
|
|
|
|
192
|
return bless { |
242
|
|
|
|
|
|
|
dt => DateTime->$method( %arg ), |
243
|
|
|
|
|
|
|
recalc => 1, |
244
|
|
|
|
|
|
|
%my_arg, |
245
|
|
|
|
|
|
|
}, $class; |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub from_object { |
250
|
1
|
|
|
1
|
1
|
681
|
my ( $class, %arg ) = @_; |
251
|
|
|
|
|
|
|
|
252
|
1
|
|
|
|
|
3
|
my %my_arg; |
253
|
1
|
|
33
|
|
|
9
|
my $shire_object = $arg{object} && eval { |
254
|
|
|
|
|
|
|
$arg{object}->isa( __PACKAGE__ ) }; |
255
|
1
|
|
|
|
|
5
|
foreach my $name ( qw{ accented traditional } ) { |
256
|
2
|
50
|
|
|
|
10
|
if ( exists $arg{$name} ) { |
|
|
50
|
|
|
|
|
|
257
|
0
|
|
|
|
|
0
|
$my_arg{$name} = delete $arg{$name}; |
258
|
|
|
|
|
|
|
} elsif ( $shire_object ) { |
259
|
0
|
|
|
|
|
0
|
$my_arg{$name} = $arg{object}->$name(); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
1
|
|
|
|
|
32
|
%my_arg = $validator->( %my_arg ); |
264
|
|
|
|
|
|
|
|
265
|
1
|
|
|
|
|
31
|
my $self = bless { |
266
|
|
|
|
|
|
|
dt => DateTime->from_object( %arg ), |
267
|
|
|
|
|
|
|
recalc => 1, |
268
|
|
|
|
|
|
|
%my_arg, |
269
|
|
|
|
|
|
|
}, $class; |
270
|
|
|
|
|
|
|
|
271
|
1
|
|
|
|
|
912
|
return $self; |
272
|
|
|
|
|
|
|
} |
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sub last_day_of_month { |
276
|
1
|
|
|
1
|
1
|
12
|
my ( $class, %arg ) = @_; |
277
|
1
|
|
|
|
|
4
|
$arg{day} = 30; # The shire calendar is nice this way |
278
|
1
|
|
|
|
|
6
|
return $class->new( %arg ); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
{ |
282
|
|
|
|
|
|
|
my $validator = Params::ValidationCompiler::validation_for( |
283
|
|
|
|
|
|
|
name => '_validation_for_from_day_of_year', |
284
|
|
|
|
|
|
|
name_is_optional => 1, |
285
|
|
|
|
|
|
|
params => { |
286
|
|
|
|
|
|
|
year => { |
287
|
|
|
|
|
|
|
type => __t( 'Year' ), |
288
|
|
|
|
|
|
|
}, |
289
|
|
|
|
|
|
|
day_of_year => { |
290
|
|
|
|
|
|
|
type => __t( 'DayOfYear' ), |
291
|
|
|
|
|
|
|
}, |
292
|
|
|
|
|
|
|
hour => { |
293
|
|
|
|
|
|
|
type => __t( 'Hour' ), |
294
|
|
|
|
|
|
|
default => 0, |
295
|
|
|
|
|
|
|
}, |
296
|
|
|
|
|
|
|
minute => { |
297
|
|
|
|
|
|
|
type => __t( 'Minute' ), |
298
|
|
|
|
|
|
|
default => 0, |
299
|
|
|
|
|
|
|
}, |
300
|
|
|
|
|
|
|
second => { |
301
|
|
|
|
|
|
|
type => __t( 'Second' ), |
302
|
|
|
|
|
|
|
default => 0, |
303
|
|
|
|
|
|
|
}, |
304
|
|
|
|
|
|
|
nanosecond => { |
305
|
|
|
|
|
|
|
type => __t( 'Nanosecond' ), |
306
|
|
|
|
|
|
|
default => 0, |
307
|
|
|
|
|
|
|
}, |
308
|
|
|
|
|
|
|
time_zone => { |
309
|
|
|
|
|
|
|
type => __t( 'TimeZone' ), |
310
|
|
|
|
|
|
|
optional => 1, |
311
|
|
|
|
|
|
|
}, |
312
|
|
|
|
|
|
|
locale => { |
313
|
|
|
|
|
|
|
type => __t( 'Locale' ), |
314
|
|
|
|
|
|
|
optional => 1, |
315
|
|
|
|
|
|
|
}, |
316
|
|
|
|
|
|
|
formatter => { |
317
|
|
|
|
|
|
|
type => __t( 'Formatter' ), |
318
|
|
|
|
|
|
|
optional => 1, |
319
|
|
|
|
|
|
|
}, |
320
|
|
|
|
|
|
|
accented => { |
321
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
322
|
|
|
|
|
|
|
optional => 1, |
323
|
|
|
|
|
|
|
}, |
324
|
|
|
|
|
|
|
traditional => { |
325
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
326
|
|
|
|
|
|
|
optional => 1, |
327
|
|
|
|
|
|
|
}, |
328
|
|
|
|
|
|
|
}, |
329
|
|
|
|
|
|
|
); |
330
|
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
sub from_day_of_year { |
332
|
1
|
|
|
1
|
1
|
10
|
my ( $class, @args ) = @_; |
333
|
|
|
|
|
|
|
|
334
|
1
|
|
|
|
|
26
|
my %arg = $validator->( @args ); |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
( $arg{month}, $arg{day} ) = __day_of_year_to_date( |
337
|
|
|
|
|
|
|
$arg{year}, |
338
|
|
|
|
|
|
|
delete $arg{day_of_year}, |
339
|
1
|
|
|
|
|
122
|
); |
340
|
|
|
|
|
|
|
|
341
|
1
|
|
|
|
|
99
|
return $class->_new( %arg ); |
342
|
|
|
|
|
|
|
} |
343
|
|
|
|
|
|
|
} |
344
|
|
|
|
|
|
|
|
345
|
|
|
|
|
|
|
sub now_local { |
346
|
0
|
|
|
0
|
1
|
0
|
my ( $class, %arg ) = @_; |
347
|
0
|
|
|
|
|
0
|
my %dt_arg; |
348
|
0
|
|
|
|
|
0
|
@dt_arg{ qw< second minute hour day month year > } = localtime; |
349
|
0
|
|
|
|
|
0
|
$dt_arg{month} += 1; |
350
|
0
|
|
|
|
|
0
|
$dt_arg{year} += 1900; |
351
|
0
|
|
|
|
|
0
|
return $class->from_object( %arg, object => DateTime->new( %dt_arg ) ); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
|
354
|
|
|
|
|
|
|
sub calendar_name { |
355
|
1
|
|
|
1
|
1
|
673
|
return 'Shire'; |
356
|
|
|
|
|
|
|
} |
357
|
|
|
|
|
|
|
|
358
|
|
|
|
|
|
|
sub clone { |
359
|
6
|
|
|
6
|
1
|
5708
|
my ( $self ) = @_; |
360
|
6
|
|
|
|
|
13
|
my $clone = { %{ $self } }; |
|
6
|
|
|
|
|
39
|
|
361
|
6
|
|
|
|
|
30
|
$clone->{dt} = $self->{dt}->clone(); |
362
|
6
|
|
|
|
|
98
|
return bless $clone, ref $self; |
363
|
|
|
|
|
|
|
} |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
# Get methods |
366
|
|
|
|
|
|
|
sub year { |
367
|
72
|
|
|
72
|
1
|
5669
|
my $self = shift; |
368
|
72
|
100
|
|
|
|
212
|
$self->_recalc_Shire if $self->{recalc}; |
369
|
72
|
|
|
|
|
202
|
return $self->{year}; |
370
|
|
|
|
|
|
|
} # end sub year |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
sub month { |
373
|
177
|
|
|
177
|
1
|
13343
|
my $self = shift; |
374
|
177
|
100
|
|
|
|
553
|
$self->_recalc_Shire if $self->{recalc}; |
375
|
177
|
|
|
|
|
534
|
return $self->{month}; |
376
|
|
|
|
|
|
|
} # end sub month |
377
|
|
|
|
|
|
|
|
378
|
|
|
|
|
|
|
*mon = \&month; # sub mon; |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub month_name { |
381
|
1
|
|
|
1
|
1
|
3
|
my ( $self ) = @_; |
382
|
1
|
|
|
|
|
4
|
return __month_name( $self->month() ); |
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
sub month_abbr { |
386
|
1
|
|
|
1
|
0
|
695
|
my ( $self ) = @_; |
387
|
1
|
|
|
|
|
4
|
return __month_abbr( $self->month() ); |
388
|
|
|
|
|
|
|
} |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
sub day_of_month { |
391
|
25
|
|
|
25
|
1
|
1045
|
my $self = shift; |
392
|
25
|
50
|
|
|
|
76
|
$self->_recalc_Shire if $self->{recalc}; |
393
|
25
|
|
|
|
|
113
|
return $self->{day}; |
394
|
|
|
|
|
|
|
} # end sub day_of_month |
395
|
|
|
|
|
|
|
|
396
|
|
|
|
|
|
|
*day = \&day_of_month; # sub day; |
397
|
|
|
|
|
|
|
*mday = \&day_of_month; # sub mday; |
398
|
|
|
|
|
|
|
|
399
|
|
|
|
|
|
|
sub day_of_week { |
400
|
24
|
|
|
24
|
1
|
89
|
my $self = shift; |
401
|
24
|
50
|
|
|
|
76
|
$self->_recalc_Shire if $self->{recalc}; |
402
|
24
|
|
|
|
|
108
|
return $self->{wday}; |
403
|
|
|
|
|
|
|
} # end sub day_of_week |
404
|
|
|
|
|
|
|
|
405
|
|
|
|
|
|
|
*wday = \&day_of_week; # sub wday; |
406
|
|
|
|
|
|
|
*dow = \&day_of_week; # sub dow; |
407
|
|
|
|
|
|
|
*local_day_of_week = \&day_of_week; # sub local_day_of_week; |
408
|
|
|
|
|
|
|
|
409
|
|
|
|
|
|
|
sub day_name { |
410
|
1
|
|
|
1
|
1
|
4
|
my ( $self ) = @_; |
411
|
1
|
|
|
|
|
4
|
return __weekday_name( $self->day_of_week() ); |
412
|
|
|
|
|
|
|
} |
413
|
|
|
|
|
|
|
|
414
|
|
|
|
|
|
|
sub day_name_trad { |
415
|
0
|
|
|
0
|
1
|
0
|
my ( $self ) = @_; |
416
|
0
|
|
|
|
|
0
|
return __trad_weekday_name( $self->day_of_week() ); |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub day_abbr { |
420
|
1
|
|
|
1
|
1
|
689
|
my ( $self ) = @_; |
421
|
1
|
|
|
|
|
4
|
return __weekday_abbr( $self->day_of_week() ); |
422
|
|
|
|
|
|
|
} |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
sub day_abbr_trad { |
425
|
0
|
|
|
0
|
1
|
0
|
my ( $self ) = @_; |
426
|
0
|
|
|
|
|
0
|
return __trad_weekday_abbr( $self->day_of_week() ); |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
|
429
|
|
|
|
|
|
|
sub holiday { |
430
|
35
|
|
|
35
|
1
|
1236
|
my ( $self ) = @_; |
431
|
35
|
50
|
|
|
|
102
|
$self->_recalc_Shire if $self->{recalc}; |
432
|
35
|
|
|
|
|
109
|
return $self->{holiday}; |
433
|
|
|
|
|
|
|
} |
434
|
|
|
|
|
|
|
|
435
|
|
|
|
|
|
|
sub holiday_name { |
436
|
2
|
|
|
2
|
1
|
7
|
my ( $self ) = @_; |
437
|
2
|
|
|
|
|
6
|
return __holiday_name( $self->holiday() ); |
438
|
|
|
|
|
|
|
} |
439
|
|
|
|
|
|
|
|
440
|
|
|
|
|
|
|
sub holiday_abbr { |
441
|
2
|
|
|
2
|
1
|
1357
|
my ( $self ) = @_; |
442
|
2
|
|
|
|
|
9
|
return __holiday_abbr( $self->holiday() ); |
443
|
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
|
|
445
|
|
|
|
|
|
|
sub is_leap_year { |
446
|
27
|
|
|
27
|
1
|
52
|
my $self = shift; |
447
|
27
|
50
|
|
|
|
63
|
$self->_recalc_Shire if $self->{recalc}; |
448
|
27
|
|
|
|
|
58
|
return $self->{leapyear}; |
449
|
|
|
|
|
|
|
} |
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
sub day_of_year { |
452
|
7
|
|
|
7
|
1
|
1563
|
my ( $self ) = @_; |
453
|
|
|
|
|
|
|
|
454
|
7
|
50
|
|
|
|
103
|
$self->_recalc_Shire if $self->{recalc}; |
455
|
|
|
|
|
|
|
|
456
|
|
|
|
|
|
|
return __date_to_day_of_year( |
457
|
|
|
|
|
|
|
$self->{year}, |
458
|
|
|
|
|
|
|
$self->{month}, |
459
|
|
|
|
|
|
|
$self->{day} || $self->{holiday}, |
460
|
7
|
|
66
|
|
|
51
|
); |
461
|
|
|
|
|
|
|
} |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
*doy = \&day_of_year; # sub doy |
464
|
|
|
|
|
|
|
|
465
|
0
|
|
|
0
|
1
|
0
|
sub week { return ($_[0]->week_year, $_[0]->week_number); } |
466
|
|
|
|
|
|
|
|
467
|
|
|
|
|
|
|
*week_year = \&year; # sub week_year; the shire calendar is nice this way |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
sub week_number { |
470
|
2
|
|
|
2
|
1
|
698
|
my $self = shift; |
471
|
|
|
|
|
|
|
# TODO re-implement in terms of __week_of_year |
472
|
2
|
|
|
|
|
6
|
my $yday = $self->day_of_year; |
473
|
|
|
|
|
|
|
|
474
|
2
|
100
|
|
|
|
175
|
DAY_NUMBER_MIDYEARS_DAY == $yday |
475
|
|
|
|
|
|
|
and return 0; |
476
|
1
|
50
|
|
|
|
4
|
DAY_NUMBER_MIDYEARS_DAY < $yday |
477
|
|
|
|
|
|
|
and --$yday; |
478
|
|
|
|
|
|
|
|
479
|
1
|
50
|
|
|
|
4
|
if ( $self->is_leap_year() ) { |
480
|
|
|
|
|
|
|
# In the following, DAY_NUMBER_MIDYEARS_DAY really refers to the |
481
|
|
|
|
|
|
|
# Ovelithe, because days greater than Midyear's day were |
482
|
|
|
|
|
|
|
# decremented above. |
483
|
0
|
0
|
|
|
|
0
|
DAY_NUMBER_MIDYEARS_DAY == $yday |
484
|
|
|
|
|
|
|
and return 0; |
485
|
0
|
0
|
|
|
|
0
|
DAY_NUMBER_MIDYEARS_DAY < $yday |
486
|
|
|
|
|
|
|
and --$yday; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
|
489
|
1
|
|
|
|
|
8
|
return int( ( $yday - 1 ) / 7 ) + 1; |
490
|
|
|
|
|
|
|
} |
491
|
|
|
|
|
|
|
|
492
|
|
|
|
|
|
|
sub quarter { |
493
|
6
|
|
|
6
|
1
|
14
|
my ( $self ) = @_; |
494
|
6
|
|
33
|
|
|
15
|
return __quarter( $self->month(), $self->day() || $self->holiday() ); |
495
|
|
|
|
|
|
|
} |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
sub quarter_name { |
498
|
1
|
|
|
1
|
1
|
664
|
my ( $self ) = @_; |
499
|
1
|
|
|
|
|
4
|
return __quarter_name( $self->quarter() ); |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
|
502
|
|
|
|
|
|
|
sub quarter_abbr { |
503
|
1
|
|
|
1
|
1
|
732
|
my ( $self ) = @_; |
504
|
1
|
|
|
|
|
4
|
return __quarter_abbr( $self->quarter() ); |
505
|
|
|
|
|
|
|
} |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
sub day_of_quarter { |
508
|
2
|
|
|
2
|
1
|
711
|
my ( $self ) = @_; |
509
|
2
|
|
|
|
|
9
|
my $clone = $self->clone(); |
510
|
2
|
|
|
|
|
9
|
$clone->truncate( to => 'quarter' ); |
511
|
2
|
|
|
|
|
8
|
return ( $self->local_rd_values() )[0] - ( $clone->local_rd_values())[0] + 1; |
512
|
|
|
|
|
|
|
} |
513
|
|
|
|
|
|
|
|
514
|
|
|
|
|
|
|
# sub doq; |
515
|
|
|
|
|
|
|
*doq = \&day_of_quarter; |
516
|
|
|
|
|
|
|
|
517
|
|
|
|
|
|
|
sub am_or_pm { |
518
|
0
|
|
|
0
|
0
|
0
|
splice @_, 1, $#_, '%p'; |
519
|
0
|
|
|
|
|
0
|
goto &strftime; |
520
|
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
sub era_abbr { |
523
|
0
|
0
|
|
0
|
1
|
0
|
return $_[0]->year() < 1 ? 'BSR' : 'SR'; |
524
|
|
|
|
|
|
|
} |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
# deprecated in DateTime |
527
|
|
|
|
|
|
|
# *era = \&era_abbr; |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
*christian_era = *secular_era = \&era_abbr; |
530
|
|
|
|
|
|
|
|
531
|
|
|
|
|
|
|
sub year_with_era { |
532
|
0
|
|
|
0
|
0
|
0
|
return join '', abs( $_[0]->ce_year() ), $_[0]->era_abbr(); |
533
|
|
|
|
|
|
|
} |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
sub year_with_christian_era { |
536
|
0
|
|
|
0
|
0
|
0
|
return join '', abs( $_[0]->ce_year() ), $_[0]->christian_era(); |
537
|
|
|
|
|
|
|
} |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
sub year_with_secular_era { |
540
|
0
|
|
|
0
|
0
|
0
|
return join '', abs( $_[0]->ce_year() ), $_[0]->secular_era(); |
541
|
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
sub era_name { |
544
|
0
|
0
|
|
0
|
1
|
0
|
return $_[0]->year() < 1 ? 'Before Shire Reckoning' : 'Shire Reckoning'; |
545
|
|
|
|
|
|
|
} |
546
|
|
|
|
|
|
|
|
547
|
|
|
|
|
|
|
sub ce_year { |
548
|
0
|
|
|
0
|
0
|
0
|
my $year = $_[0]->year(); |
549
|
0
|
0
|
|
|
|
0
|
return $year > 0 ? $year : $year - 1; |
550
|
|
|
|
|
|
|
} |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
sub ymd { |
553
|
41
|
|
|
41
|
0
|
2270
|
my ( $self, $sep ) = @_; |
554
|
41
|
100
|
|
|
|
132
|
defined $sep |
555
|
|
|
|
|
|
|
or $sep = '-'; |
556
|
41
|
|
|
|
|
177
|
return $self->strftime( "%{{%Y$sep%m$sep%d||%Y$sep%Ee}}" ); |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
# sub date; |
560
|
|
|
|
|
|
|
*date = \&ymd; |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
sub dmy { |
563
|
2
|
|
|
2
|
0
|
1462
|
my ( $self, $sep ) = @_; |
564
|
2
|
100
|
|
|
|
10
|
defined $sep |
565
|
|
|
|
|
|
|
or $sep = '-'; |
566
|
2
|
|
|
|
|
11
|
return $self->strftime( "%{{%d$sep%m$sep%Y||%Ee$sep%Y}}" ); |
567
|
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
|
|
569
|
|
|
|
|
|
|
sub mdy { |
570
|
2
|
|
|
2
|
0
|
1322
|
my ( $self, $sep ) = @_; |
571
|
2
|
50
|
|
|
|
8
|
defined $sep |
572
|
|
|
|
|
|
|
or $sep = '-'; |
573
|
2
|
|
|
|
|
9
|
return $self->strftime( "%{{%m$sep%d$sep%Y||%Ee$sep%Y}}" ); |
574
|
|
|
|
|
|
|
} |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
sub hms { |
577
|
8
|
|
|
8
|
0
|
2724
|
my ( $self, $sep ) = @_; |
578
|
8
|
100
|
|
|
|
26
|
defined $sep |
579
|
|
|
|
|
|
|
or $sep = ':'; |
580
|
8
|
|
|
|
|
57
|
return $self->strftime( "%H$sep%M$sep%S" ); |
581
|
|
|
|
|
|
|
} |
582
|
|
|
|
|
|
|
|
583
|
|
|
|
|
|
|
# sub time; |
584
|
|
|
|
|
|
|
# The DateTime code says the following circumlocution prevents |
585
|
|
|
|
|
|
|
# overriding of CORE::time |
586
|
|
|
|
|
|
|
*DateTime::Fiction::JRRTolkien::Shire::time = \&hms; |
587
|
|
|
|
|
|
|
|
588
|
4
|
|
|
4
|
1
|
2724
|
sub iso8601 { return join 'S', map { $_[0]->$_() } qw{ ymd hms } } |
|
8
|
|
|
|
|
199
|
|
589
|
|
|
|
|
|
|
|
590
|
12
|
|
|
12
|
1
|
52
|
sub accented { return $_[0]->{accented} } |
591
|
16
|
|
|
16
|
1
|
2106
|
sub traditional { return $_[0]->{traditional} } |
592
|
|
|
|
|
|
|
|
593
|
|
|
|
|
|
|
*datetime = \&iso8601; # sub datetime; |
594
|
|
|
|
|
|
|
|
595
|
|
|
|
|
|
|
# Set methods |
596
|
|
|
|
|
|
|
|
597
|
|
|
|
|
|
|
{ |
598
|
|
|
|
|
|
|
my $validator = Params::ValidationCompiler::validation_for( |
599
|
|
|
|
|
|
|
name => '_validation_for_set', |
600
|
|
|
|
|
|
|
name_is_optional => 1, |
601
|
|
|
|
|
|
|
params => { |
602
|
|
|
|
|
|
|
year => { |
603
|
|
|
|
|
|
|
type => __t( 'Year' ), |
604
|
|
|
|
|
|
|
optional => 1, |
605
|
|
|
|
|
|
|
}, |
606
|
|
|
|
|
|
|
month => { |
607
|
|
|
|
|
|
|
type => __t( 'Month' ), |
608
|
|
|
|
|
|
|
optional => 1, |
609
|
|
|
|
|
|
|
}, |
610
|
|
|
|
|
|
|
day => { |
611
|
|
|
|
|
|
|
type => __t( 'DayOfMonth' ), |
612
|
|
|
|
|
|
|
optional => 1, |
613
|
|
|
|
|
|
|
}, |
614
|
|
|
|
|
|
|
holiday => { |
615
|
|
|
|
|
|
|
type => __t( 'Holiday' ), |
616
|
|
|
|
|
|
|
optional => 1, |
617
|
|
|
|
|
|
|
}, |
618
|
|
|
|
|
|
|
hour => { |
619
|
|
|
|
|
|
|
type => __t( 'Hour' ), |
620
|
|
|
|
|
|
|
optional => 1, |
621
|
|
|
|
|
|
|
}, |
622
|
|
|
|
|
|
|
minute => { |
623
|
|
|
|
|
|
|
type => __t( 'Minute' ), |
624
|
|
|
|
|
|
|
optional => 1, |
625
|
|
|
|
|
|
|
}, |
626
|
|
|
|
|
|
|
second => { |
627
|
|
|
|
|
|
|
type => __t( 'Second' ), |
628
|
|
|
|
|
|
|
optional => 1, |
629
|
|
|
|
|
|
|
}, |
630
|
|
|
|
|
|
|
nanosecond => { |
631
|
|
|
|
|
|
|
type => __t( 'Nanosecond' ), |
632
|
|
|
|
|
|
|
optional => 1, |
633
|
|
|
|
|
|
|
}, |
634
|
|
|
|
|
|
|
locale => { |
635
|
|
|
|
|
|
|
type => __t( 'Locale' ), |
636
|
|
|
|
|
|
|
optional => 1, |
637
|
|
|
|
|
|
|
}, |
638
|
|
|
|
|
|
|
accented => { |
639
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
640
|
|
|
|
|
|
|
optional => 1, |
641
|
|
|
|
|
|
|
}, |
642
|
|
|
|
|
|
|
traditional => { |
643
|
|
|
|
|
|
|
type => __t( 'Bool' ), |
644
|
|
|
|
|
|
|
optional => 1, |
645
|
|
|
|
|
|
|
}, |
646
|
|
|
|
|
|
|
}, |
647
|
|
|
|
|
|
|
); |
648
|
|
|
|
|
|
|
|
649
|
|
|
|
|
|
|
sub set { |
650
|
10
|
|
|
10
|
1
|
793
|
my ( $self, @args ) = @_; |
651
|
|
|
|
|
|
|
|
652
|
10
|
|
|
|
|
228
|
my %my_arg = $validator->( @args ); |
653
|
|
|
|
|
|
|
|
654
|
10
|
|
|
|
|
1073
|
_check_date( \%my_arg ); |
655
|
|
|
|
|
|
|
|
656
|
10
|
50
|
|
|
|
32
|
$self->_recalc_Shire if $self->{recalc}; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
$my_arg{day} |
659
|
|
|
|
|
|
|
and not $my_arg{month} |
660
|
|
|
|
|
|
|
and not $self->{month} |
661
|
10
|
50
|
100
|
|
|
44
|
and _croak( 'Need to set month as well as day' ); |
|
|
|
66
|
|
|
|
|
662
|
|
|
|
|
|
|
|
663
|
10
|
100
|
|
|
|
25
|
if ( $my_arg{month} ) { |
664
|
3
|
|
100
|
|
|
16
|
$my_arg{day} ||= 1; |
665
|
3
|
|
|
|
|
10
|
$self->{month} = __month_name_to_number( $my_arg{month} ); |
666
|
3
|
|
|
|
|
112
|
$self->{holiday} = 0; |
667
|
|
|
|
|
|
|
} |
668
|
|
|
|
|
|
|
|
669
|
10
|
100
|
|
|
|
25
|
if ( $my_arg{holiday} ) { |
670
|
5
|
|
|
|
|
21
|
$self->{holiday} = __holiday_name_to_number( $my_arg{holiday} ); |
671
|
5
|
|
|
|
|
205
|
$self->{day} = $self->{month} = 0; |
672
|
|
|
|
|
|
|
} |
673
|
|
|
|
|
|
|
|
674
|
10
|
100
|
|
|
|
26
|
if ( $my_arg{day} ) { |
675
|
5
|
|
|
|
|
11
|
$self->{day} = $my_arg{day}; |
676
|
5
|
|
|
|
|
11
|
$self->{holiday} = 0; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
10
|
|
|
|
|
24
|
foreach my $name ( qw{ year accented traditional } ) { |
680
|
|
|
|
|
|
|
defined $my_arg{$name} |
681
|
30
|
100
|
|
|
|
74
|
and $self->{$name} = $my_arg{$name}; |
682
|
|
|
|
|
|
|
} |
683
|
|
|
|
|
|
|
|
684
|
10
|
|
|
|
|
31
|
$self->{leapyear} = __is_leap_year( $self->{year} ); |
685
|
|
|
|
|
|
|
$self->{wday} = __day_of_week( |
686
|
|
|
|
|
|
|
$self->{month}, |
687
|
|
|
|
|
|
|
$self->{day} || $self->{holiday}, |
688
|
10
|
|
66
|
|
|
295
|
); |
689
|
|
|
|
|
|
|
|
690
|
10
|
|
|
|
|
365
|
my %dt_args; |
691
|
10
|
|
|
|
|
24
|
foreach my $arg ( @delegate_to_dt ) { |
692
|
50
|
100
|
|
|
|
130
|
$dt_args{$arg} = $my_arg{$arg} if defined $my_arg{$arg}; |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
|
695
|
10
|
|
|
|
|
41
|
$self->_recalc_DateTime( %dt_args ); |
696
|
|
|
|
|
|
|
|
697
|
10
|
|
|
|
|
43
|
return $self; |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
} |
700
|
|
|
|
|
|
|
|
701
|
|
|
|
|
|
|
# sub set_year; sub set_month; sub set_day; sub set_holiday; |
702
|
|
|
|
|
|
|
# sub set_hour; sub set_minute; sub set_second; sub set_nanosecond; |
703
|
|
|
|
|
|
|
# sub set_accented; sub set_traditional; |
704
|
|
|
|
|
|
|
foreach my $attr ( qw{ |
705
|
|
|
|
|
|
|
year month day holiday |
706
|
|
|
|
|
|
|
hour minute second nanosecond |
707
|
|
|
|
|
|
|
accented traditional |
708
|
|
|
|
|
|
|
} ) { |
709
|
|
|
|
|
|
|
my $method = "set_$attr"; |
710
|
9
|
|
|
9
|
|
111
|
no strict qw{ refs }; |
|
9
|
|
|
|
|
32
|
|
|
9
|
|
|
|
|
18452
|
|
711
|
1
|
|
|
1
|
|
5
|
*$method = sub { $_[0]->set( $attr => $_[1] ) }; |
712
|
|
|
|
|
|
|
} |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
{ |
715
|
|
|
|
|
|
|
my @midnight = ( |
716
|
|
|
|
|
|
|
hour => 0, |
717
|
|
|
|
|
|
|
minute => 0, |
718
|
|
|
|
|
|
|
second => 0, |
719
|
|
|
|
|
|
|
nanosecond => 0, |
720
|
|
|
|
|
|
|
); |
721
|
|
|
|
|
|
|
|
722
|
|
|
|
|
|
|
my @quarter_start = ( |
723
|
|
|
|
|
|
|
undef, |
724
|
|
|
|
|
|
|
[ holiday => 1 ], |
725
|
|
|
|
|
|
|
[ month => 4, day => 1 ], |
726
|
|
|
|
|
|
|
[ holiday => 5 ], |
727
|
|
|
|
|
|
|
[ month => 10, day => 1 ], |
728
|
|
|
|
|
|
|
); |
729
|
|
|
|
|
|
|
|
730
|
|
|
|
|
|
|
my %handler = ( |
731
|
|
|
|
|
|
|
year => sub { |
732
|
|
|
|
|
|
|
$_[0]->set( |
733
|
|
|
|
|
|
|
holiday => 1, |
734
|
|
|
|
|
|
|
@midnight, |
735
|
|
|
|
|
|
|
); |
736
|
|
|
|
|
|
|
}, |
737
|
|
|
|
|
|
|
quarter => sub { |
738
|
|
|
|
|
|
|
my ( $self ) = @_; |
739
|
|
|
|
|
|
|
# This is an extension to the Shire calendar by Tom Wyant. |
740
|
|
|
|
|
|
|
# It has no textual justification whatsoever. Feel free to |
741
|
|
|
|
|
|
|
# pretend it does not exist. |
742
|
|
|
|
|
|
|
if ( my $quarter = $self->quarter() ) { |
743
|
|
|
|
|
|
|
# The start of a quarter is tricky since quarters 1 and |
744
|
|
|
|
|
|
|
# 3 start on holidays, so we just do a table lookup. |
745
|
|
|
|
|
|
|
$self->set( |
746
|
|
|
|
|
|
|
@{ $quarter_start[ $quarter ] }, |
747
|
|
|
|
|
|
|
@midnight, |
748
|
|
|
|
|
|
|
); |
749
|
|
|
|
|
|
|
} else { |
750
|
|
|
|
|
|
|
# Since Midyear's day and the Overlithe are not part of |
751
|
|
|
|
|
|
|
# any quarter, we just truncate them to the nearest day. |
752
|
|
|
|
|
|
|
$self->{dt}->truncate( to => 'day' ); |
753
|
|
|
|
|
|
|
} |
754
|
|
|
|
|
|
|
}, |
755
|
|
|
|
|
|
|
month => sub { |
756
|
|
|
|
|
|
|
my ( $self ) = @_; |
757
|
|
|
|
|
|
|
if ( $self->{holiday} ) { |
758
|
|
|
|
|
|
|
# since holidays aren't in any month, this means we just |
759
|
|
|
|
|
|
|
# lop off any time |
760
|
|
|
|
|
|
|
$self->{dt}->truncate( to => 'day' ); |
761
|
|
|
|
|
|
|
} else { |
762
|
|
|
|
|
|
|
$self->set( |
763
|
|
|
|
|
|
|
day => 1, |
764
|
|
|
|
|
|
|
@midnight, |
765
|
|
|
|
|
|
|
); |
766
|
|
|
|
|
|
|
} |
767
|
|
|
|
|
|
|
}, |
768
|
|
|
|
|
|
|
week => sub { |
769
|
|
|
|
|
|
|
my ( $self ) = @_; |
770
|
|
|
|
|
|
|
if ( $self->{wday} ) { |
771
|
|
|
|
|
|
|
# TODO we do not, at this point in the coding, have date |
772
|
|
|
|
|
|
|
# arithmetic. So we do it with rata die. |
773
|
|
|
|
|
|
|
my ( $year, $day_of_year ) = __rata_die_to_year_day( |
774
|
|
|
|
|
|
|
( $self->local_rd_values() )[0] - $self->{wday} + 1 + |
775
|
|
|
|
|
|
|
GREGORIAN_RATA_DIE_TO_SHIRE |
776
|
|
|
|
|
|
|
); |
777
|
|
|
|
|
|
|
my ( $month, $day ) = __day_of_year_to_date( |
778
|
|
|
|
|
|
|
$year, $day_of_year ); |
779
|
|
|
|
|
|
|
my %set_arg = ( |
780
|
|
|
|
|
|
|
year => $year, |
781
|
|
|
|
|
|
|
@midnight, |
782
|
|
|
|
|
|
|
); |
783
|
|
|
|
|
|
|
if ( $month ) { |
784
|
|
|
|
|
|
|
@set_arg{ qw{ month day } } = ( $month, $day ); |
785
|
|
|
|
|
|
|
} else { |
786
|
|
|
|
|
|
|
$set_arg{holiday} = $day; |
787
|
|
|
|
|
|
|
} |
788
|
|
|
|
|
|
|
$self->set( %set_arg ); |
789
|
|
|
|
|
|
|
} else { |
790
|
|
|
|
|
|
|
$self->{dt}->truncate( to => 'day' ); |
791
|
|
|
|
|
|
|
} |
792
|
|
|
|
|
|
|
}, |
793
|
|
|
|
|
|
|
); |
794
|
|
|
|
|
|
|
|
795
|
|
|
|
|
|
|
# Weeks in the Shire start on Sterday, but that's what 'week' gives |
796
|
|
|
|
|
|
|
# us. |
797
|
|
|
|
|
|
|
$handler{local_week} = $handler{week}; |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
my $validator = Params::ValidationCompiler::validation_for( |
800
|
|
|
|
|
|
|
name => '_validation_for_truncate', |
801
|
|
|
|
|
|
|
name_is_optional => 1, |
802
|
|
|
|
|
|
|
params => { |
803
|
|
|
|
|
|
|
to => { |
804
|
|
|
|
|
|
|
type => __t( 'TruncationLevel' ), |
805
|
|
|
|
|
|
|
}, |
806
|
|
|
|
|
|
|
}, |
807
|
|
|
|
|
|
|
); |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
sub truncate : method { ## no critic (ProhibitBuiltInHomonyms) |
810
|
6
|
|
|
6
|
1
|
1250
|
my ( $self, @args ) = @_; |
811
|
|
|
|
|
|
|
|
812
|
6
|
|
|
|
|
157
|
my %my_arg = $validator->( @args ); |
813
|
|
|
|
|
|
|
|
814
|
6
|
50
|
|
|
|
171
|
$self->_recalc_Shire if $self->{recalc}; |
815
|
|
|
|
|
|
|
|
816
|
6
|
100
|
|
|
|
24
|
if ( my $code = $handler{$my_arg{to}} ) { |
817
|
5
|
|
|
|
|
18
|
$code->( $self ); |
818
|
|
|
|
|
|
|
} else { |
819
|
|
|
|
|
|
|
# only time components will change, DateTime can handle it |
820
|
|
|
|
|
|
|
# fine on its own |
821
|
1
|
|
|
|
|
7
|
$self->{dt}->truncate( to => $my_arg{to} ); |
822
|
|
|
|
|
|
|
} |
823
|
|
|
|
|
|
|
|
824
|
6
|
|
|
|
|
317
|
return $self; |
825
|
|
|
|
|
|
|
} |
826
|
|
|
|
|
|
|
} |
827
|
|
|
|
|
|
|
|
828
|
|
|
|
|
|
|
sub set_time_zone { |
829
|
1
|
|
|
1
|
1
|
4
|
my ($self, $tz) = @_; |
830
|
1
|
|
|
|
|
7
|
$self->{dt}->set_time_zone($tz); |
831
|
1
|
|
|
|
|
28
|
$self->{recalc} = 1; # in case the day flips when the timezone changes |
832
|
1
|
|
|
|
|
5
|
return $self; |
833
|
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
|
|
835
|
|
|
|
|
|
|
# The following two methods were lifted pretty much verbatim from |
836
|
|
|
|
|
|
|
# DateTime. The only changes were the guard against holidays (month == |
837
|
|
|
|
|
|
|
# 0) and the use of POSIX::floor() rather than int() or use integer; |
838
|
|
|
|
|
|
|
sub weekday_of_month { |
839
|
1
|
|
|
1
|
1
|
4
|
my ( $self ) = @_; |
840
|
1
|
50
|
|
|
|
4
|
$self->month() |
841
|
|
|
|
|
|
|
or return 0; |
842
|
1
|
|
|
|
|
5
|
return POSIX::floor( ( ( $_[0]->day - 1 ) / 7 ) + 1 ); |
843
|
|
|
|
|
|
|
} |
844
|
|
|
|
|
|
|
# ISO says that the first week of a year is the first week containing |
845
|
|
|
|
|
|
|
# a Thursday. Extending that says that the first week of the month is |
846
|
|
|
|
|
|
|
# the first week containing a Thursday. ICU agrees. |
847
|
|
|
|
|
|
|
# ISO does not really apply to the Shire calendar. This method is |
848
|
|
|
|
|
|
|
# algorithmically the same as the DateTime method, which amounts to |
849
|
|
|
|
|
|
|
# taking the first week of the year to be the first week containing a |
850
|
|
|
|
|
|
|
# Hevensday. We return nothing (undef in scalar context) on a holiday |
851
|
|
|
|
|
|
|
# because zero is a valid return (e.g. for 1 Rethe). -- TRW |
852
|
|
|
|
|
|
|
sub week_of_month { |
853
|
1
|
|
|
1
|
1
|
3
|
my ( $self ) = @_; |
854
|
1
|
50
|
|
|
|
4
|
$self->month() |
855
|
|
|
|
|
|
|
or return; |
856
|
1
|
|
|
|
|
4
|
my $hev = $self->day() + 4 - $self->day_of_week(); |
857
|
1
|
|
|
|
|
8
|
return POSIX::floor( ( $hev + 6 ) / 7 ); |
858
|
|
|
|
|
|
|
} |
859
|
|
|
|
|
|
|
|
860
|
|
|
|
|
|
|
sub strftime { |
861
|
69
|
|
|
69
|
1
|
176
|
my ( $self, @fmt ) = @_; |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
return wantarray ? |
864
|
69
|
100
|
|
|
|
298
|
( map { __format( $self, $_ ) } @fmt ) : |
|
8
|
|
|
|
|
21
|
|
865
|
|
|
|
|
|
|
__format( $self, $fmt[0] ); |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
# Arithmetic |
869
|
|
|
|
|
|
|
|
870
|
|
|
|
|
|
|
sub duration_class { |
871
|
37
|
|
|
37
|
0
|
173
|
return 'DateTime::Fiction::JRRTolkien::Shire::Duration'; |
872
|
|
|
|
|
|
|
} |
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
sub _make_duration { |
875
|
33
|
|
|
33
|
|
67
|
my ( $self, @arg ) = @_; |
876
|
|
|
|
|
|
|
|
877
|
33
|
50
|
33
|
|
|
114
|
1 == @arg |
878
|
|
|
|
|
|
|
and _isa( $arg[0], $self->duration_class() ) |
879
|
|
|
|
|
|
|
and return $arg[0]; |
880
|
|
|
|
|
|
|
|
881
|
33
|
|
|
|
|
77
|
return $self->duration_class()->new( @arg ); |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
sub add { |
885
|
16
|
|
|
16
|
1
|
820
|
my ( $self, @arg ) = @_; |
886
|
16
|
|
|
|
|
42
|
return $self->add_duration( $self->_make_duration( @arg ) ); |
887
|
|
|
|
|
|
|
} |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
{ |
890
|
|
|
|
|
|
|
my $validate = Params::ValidationCompiler::validation_for( |
891
|
|
|
|
|
|
|
name => '_check_add_duration_params', |
892
|
|
|
|
|
|
|
name_is_optional => 1, |
893
|
|
|
|
|
|
|
params => [ |
894
|
|
|
|
|
|
|
{ type => __t( 'Duration' ) }, |
895
|
|
|
|
|
|
|
], |
896
|
|
|
|
|
|
|
); |
897
|
|
|
|
|
|
|
|
898
|
|
|
|
|
|
|
sub add_duration { |
899
|
16
|
|
|
16
|
1
|
1776
|
my ( $self, @arg ) = @_; |
900
|
16
|
|
|
|
|
325
|
my ( $dur ) = $validate->( @arg ); |
901
|
16
|
|
|
|
|
356
|
return $self->_add_duration( $dur ); |
902
|
|
|
|
|
|
|
} |
903
|
|
|
|
|
|
|
|
904
|
|
|
|
|
|
|
sub subtract_duration { |
905
|
17
|
|
|
17
|
1
|
1835
|
my ( $self, @arg ) = @_; |
906
|
17
|
|
|
|
|
338
|
my ( $dur ) = $validate->( @arg ); |
907
|
17
|
|
|
|
|
410
|
return $self->_add_duration( $dur->inverse() ); |
908
|
|
|
|
|
|
|
} |
909
|
|
|
|
|
|
|
} |
910
|
|
|
|
|
|
|
|
911
|
|
|
|
|
|
|
{ |
912
|
|
|
|
|
|
|
# The _offset arrays are accessed by |
913
|
|
|
|
|
|
|
# @xx_offset[$self->is_leap_year][$forward][$holiday]; |
914
|
|
|
|
|
|
|
my @month_offset = ( |
915
|
|
|
|
|
|
|
[ # Not a leap year |
916
|
|
|
|
|
|
|
[ 0, -2, -1, -2, 0, -3, -1 ], # Going backward |
917
|
|
|
|
|
|
|
[ 0, 1, 3, 2, 0, 1, 2 ], # Going forward |
918
|
|
|
|
|
|
|
], |
919
|
|
|
|
|
|
|
[ # A leap year |
920
|
|
|
|
|
|
|
[ 0, -2, -1, -2, -3, -4, -1 ], # Going backward |
921
|
|
|
|
|
|
|
[ 0, 1, 4, 3, 2, 1, 2 ], # Going forward |
922
|
|
|
|
|
|
|
], |
923
|
|
|
|
|
|
|
); |
924
|
|
|
|
|
|
|
my @week_offset = ( # Note that we only use indices 3 & 4 |
925
|
|
|
|
|
|
|
[ # Not a leap year |
926
|
|
|
|
|
|
|
[ 0, 0, 0, -1, 0, 0, 0 ], # Going backward |
927
|
|
|
|
|
|
|
[ 0, 0, 0, 1, 0, 0, 0 ], # Going forward |
928
|
|
|
|
|
|
|
], |
929
|
|
|
|
|
|
|
[ # A leap year |
930
|
|
|
|
|
|
|
[ 0, 0, 0, -1, -2, 0, 0 ], # Going backward |
931
|
|
|
|
|
|
|
[ 0, 0, 0, 2, 1, 0, 0 ], # Going forward |
932
|
|
|
|
|
|
|
], |
933
|
|
|
|
|
|
|
); |
934
|
|
|
|
|
|
|
|
935
|
|
|
|
|
|
|
sub _add_duration { |
936
|
33
|
|
|
33
|
|
76
|
my ( $self, $dur ) = @_; |
937
|
|
|
|
|
|
|
|
938
|
|
|
|
|
|
|
# simple optimization (cribbed shamelessly from DateTime) |
939
|
33
|
50
|
|
|
|
99
|
$dur->is_zero() |
940
|
|
|
|
|
|
|
and return $self; |
941
|
|
|
|
|
|
|
|
942
|
33
|
|
|
|
|
691
|
my %delta = $dur->deltas(); |
943
|
|
|
|
|
|
|
|
944
|
|
|
|
|
|
|
# This bit isn't quite right since DateTime::Infinite::Future - |
945
|
|
|
|
|
|
|
# infinite duration should NaN (cribbed shamelessly from |
946
|
|
|
|
|
|
|
# DateTime) |
947
|
33
|
|
|
|
|
515
|
foreach my $val ( values %delta ) { |
948
|
231
|
|
|
|
|
327
|
my $inf; |
949
|
231
|
50
|
|
|
|
680
|
if ( $val == DateTime->INFINITY ) { |
|
|
50
|
|
|
|
|
|
950
|
0
|
|
|
|
|
0
|
$inf = DateTime::Infinite::Future->new; |
951
|
|
|
|
|
|
|
} |
952
|
|
|
|
|
|
|
elsif ( $val == DateTime->NEG_INFINITY ) { |
953
|
0
|
|
|
|
|
0
|
$inf = DateTime::Infinite::Past->new; |
954
|
|
|
|
|
|
|
} |
955
|
|
|
|
|
|
|
|
956
|
231
|
50
|
|
|
|
482
|
if ($inf) { |
957
|
0
|
|
|
|
|
0
|
%$self = %$inf; |
958
|
0
|
|
|
|
|
0
|
bless $self, ref $inf; |
959
|
|
|
|
|
|
|
|
960
|
0
|
|
|
|
|
0
|
return $self; |
961
|
|
|
|
|
|
|
} |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
|
|
|
|
|
|
$self->is_infinite() |
965
|
33
|
50
|
|
|
|
82
|
and return $self; |
966
|
|
|
|
|
|
|
|
967
|
33
|
100
|
100
|
|
|
265
|
if ( $delta{years} || $delta{months} || $delta{weeks} ) { |
|
|
|
100
|
|
|
|
|
968
|
|
|
|
|
|
|
|
969
|
25
|
|
|
|
|
70
|
my $forward = $dur->is_forward_mode(); |
970
|
25
|
|
|
|
|
155
|
my $holiday = $self->holiday(); |
971
|
25
|
|
|
|
|
67
|
my $leap = $self->is_leap_year(); |
972
|
25
|
|
|
|
|
61
|
my $orig_rd = my $shire_rd = ( $self->local_rd_values() )[0] + |
973
|
|
|
|
|
|
|
GREGORIAN_RATA_DIE_TO_SHIRE; |
974
|
|
|
|
|
|
|
|
975
|
25
|
100
|
|
|
|
199
|
if ( my $months = delete $delta{months} ) { |
976
|
8
|
|
|
|
|
23
|
$shire_rd += |
977
|
|
|
|
|
|
|
$month_offset[$leap][$forward][$holiday]; |
978
|
8
|
|
|
|
|
19
|
$holiday = 0; # No further adjustment needed |
979
|
8
|
|
|
|
|
24
|
my ( $year, $day_of_year ) = __rata_die_to_year_day( |
980
|
|
|
|
|
|
|
$shire_rd ); |
981
|
8
|
|
|
|
|
663
|
my ( $month, $day ) = __day_of_year_to_date( $year, |
982
|
|
|
|
|
|
|
$day_of_year ); |
983
|
8
|
|
|
|
|
593
|
$month += $months - 1; # now zero-based |
984
|
8
|
|
|
|
|
26
|
$year += POSIX::floor( $month / 12 ); |
985
|
8
|
|
|
|
|
23
|
$leap = __is_leap_year( $year ); |
986
|
8
|
|
|
|
|
177
|
$month = 1 + $month % 12; # now one-based again |
987
|
8
|
|
|
|
|
22
|
$day_of_year = __date_to_day_of_year( $year, $month, |
988
|
|
|
|
|
|
|
$day ); |
989
|
8
|
|
|
|
|
539
|
$shire_rd = __year_day_to_rata_die( $year, $day_of_year ); |
990
|
|
|
|
|
|
|
} |
991
|
|
|
|
|
|
|
|
992
|
25
|
100
|
|
|
|
352
|
if ( my $weeks = delete $delta{weeks} ) { |
993
|
11
|
|
|
|
|
27
|
$shire_rd += $week_offset[$leap][$forward][$holiday]; |
994
|
11
|
|
|
|
|
34
|
my ( $year, $day_of_year ) = __rata_die_to_year_day( |
995
|
|
|
|
|
|
|
$shire_rd ); |
996
|
11
|
|
|
|
|
947
|
my ( $month, $day ) = __day_of_year_to_date( $year, |
997
|
|
|
|
|
|
|
$day_of_year ); |
998
|
11
|
|
|
|
|
782
|
my $week = __week_of_year( $month, $day ); |
999
|
11
|
|
|
|
|
408
|
my $day_of_week = __day_of_week( $month, $day ); |
1000
|
11
|
|
|
|
|
372
|
$week += $weeks - 1; # now zero-based |
1001
|
11
|
|
|
|
|
36
|
$year += POSIX::floor( $week / 52 ); |
1002
|
11
|
|
|
|
|
27
|
$leap = __is_leap_year( $year ); |
1003
|
11
|
|
|
|
|
238
|
$week = $week % 52; |
1004
|
11
|
|
|
|
|
21
|
$day_of_year = $week * 7 + $day_of_week; |
1005
|
11
|
100
|
|
|
|
31
|
$week > 25 # Still zero-based, remember |
1006
|
|
|
|
|
|
|
and $day_of_year += $leap + 1; |
1007
|
11
|
|
|
|
|
28
|
$shire_rd = __year_day_to_rata_die( $year, $day_of_year ); |
1008
|
|
|
|
|
|
|
} |
1009
|
|
|
|
|
|
|
|
1010
|
25
|
100
|
|
|
|
453
|
if ( my $years = delete $delta{years} ) { |
1011
|
6
|
|
|
|
|
20
|
my ( $year, $day_of_year ) = __rata_die_to_year_day( |
1012
|
|
|
|
|
|
|
$shire_rd ); |
1013
|
6
|
|
|
|
|
520
|
my ( $month, $day ) = __day_of_year_to_date( $year, |
1014
|
|
|
|
|
|
|
$day_of_year ); |
1015
|
6
|
|
|
|
|
400
|
my $y = $year + $years; |
1016
|
6
|
|
|
|
|
15
|
my $l = __is_leap_year( $y ); |
1017
|
|
|
|
|
|
|
# If we're leap year day and the new year is not a leap |
1018
|
|
|
|
|
|
|
# year we have to adjust. |
1019
|
6
|
100
|
100
|
|
|
159
|
if ( ! $l && ! $month && $day == 4 ) { |
|
|
|
66
|
|
|
|
|
1020
|
4
|
100
|
|
|
|
12
|
$day += $forward ? 1 : -1; |
1021
|
|
|
|
|
|
|
} |
1022
|
6
|
|
|
|
|
19
|
$day_of_year = __date_to_day_of_year( $y, $month, $day); |
1023
|
6
|
|
|
|
|
406
|
$shire_rd = __year_day_to_rata_die( $y, $day_of_year ); |
1024
|
6
|
|
|
|
|
222
|
$leap = $l; |
1025
|
6
|
100
|
|
|
|
19
|
$holiday = $month ? 0 : $day; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
|
1028
|
25
|
|
|
|
|
59
|
$delta{days} += $shire_rd - $orig_rd; |
1029
|
|
|
|
|
|
|
} |
1030
|
|
|
|
|
|
|
|
1031
|
33
|
50
|
|
|
|
72
|
if ( grep { $delta{$_} } qw{ days minutes seconds nanoseconds } |
|
132
|
|
|
|
|
283
|
|
1032
|
|
|
|
|
|
|
) { |
1033
|
33
|
|
|
|
|
171
|
$self->{dt}->add( %delta ); |
1034
|
33
|
|
|
|
|
33669
|
$self->{recalc} = 1; |
1035
|
|
|
|
|
|
|
} |
1036
|
|
|
|
|
|
|
|
1037
|
33
|
|
|
|
|
155
|
return $self; |
1038
|
|
|
|
|
|
|
} |
1039
|
|
|
|
|
|
|
} |
1040
|
|
|
|
|
|
|
|
1041
|
|
|
|
|
|
|
sub subtract { |
1042
|
17
|
|
|
17
|
1
|
833
|
my ( $self, @arg ) = @_; |
1043
|
17
|
|
|
|
|
58
|
return $self->subtract_duration( $self->_make_duration( @arg ) ); |
1044
|
|
|
|
|
|
|
} |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
sub subtract_datetime { |
1047
|
3
|
|
|
3
|
1
|
20
|
my ( $left, $right ) = @_; |
1048
|
3
|
50
|
|
|
|
12
|
_isa( $right, __PACKAGE__ ) |
1049
|
|
|
|
|
|
|
or Carp::croak( 'Operand must be a ', __PACKAGE__ ); |
1050
|
|
|
|
|
|
|
my %delta = $left->{dt}->subtract_datetime( $right->{dt} |
1051
|
3
|
|
|
|
|
16
|
)->deltas(); |
1052
|
3
|
|
|
|
|
913
|
$delta{years} = $left->year() - $right->year(); |
1053
|
3
|
100
|
66
|
|
|
10
|
if ( $left->month() && $right->month() ) { |
1054
|
2
|
|
|
|
|
5
|
$delta{months} = $left->month() - $right->month(); |
1055
|
2
|
|
|
|
|
8
|
$delta{days} = $left->day() - $right->day(); |
1056
|
|
|
|
|
|
|
} else { |
1057
|
1
|
|
|
|
|
6
|
$delta{days} = $left->day_of_year() - $right->day_of_year(); |
1058
|
|
|
|
|
|
|
} |
1059
|
3
|
|
|
|
|
75
|
return $left->duration_class()->new( %delta ); |
1060
|
|
|
|
|
|
|
} |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
foreach my $method ( qw{ subtract_datetime_absolute delta_days delta_md |
1063
|
|
|
|
|
|
|
delta_ms } ) { |
1064
|
9
|
|
|
9
|
|
106
|
no strict qw{ refs }; |
|
9
|
|
|
|
|
29
|
|
|
9
|
|
|
|
|
1619
|
|
1065
|
|
|
|
|
|
|
*$method = sub { |
1066
|
1
|
|
|
1
|
|
10
|
my ( $left, $right ) = @_; |
1067
|
|
|
|
|
|
|
_isa( $right, __PACKAGE__ ) |
1068
|
1
|
50
|
|
|
|
4
|
and $right = $right->{dt}; |
1069
|
1
|
50
|
|
|
|
4
|
_isa( $right, 'DateTime' ) |
1070
|
|
|
|
|
|
|
or Carp::croak( 'Operand must be a DateTime or a ', __PACKAGE__ ); |
1071
|
|
|
|
|
|
|
return $left->duration_class()->new( |
1072
|
1
|
|
|
|
|
3
|
$left->{dt}->$method( $right )->deltas() ); |
1073
|
|
|
|
|
|
|
}; |
1074
|
|
|
|
|
|
|
} |
1075
|
|
|
|
|
|
|
|
1076
|
|
|
|
|
|
|
# Comparison overloads come with DateTime. Stringify will be our own |
1077
|
|
|
|
|
|
|
use overload |
1078
|
9
|
|
|
|
|
125
|
'<=>' => \&_overload_space_ship, |
1079
|
|
|
|
|
|
|
'cmp' => \&_overload_cmp, |
1080
|
|
|
|
|
|
|
'""' => \&_stringify, |
1081
|
9
|
|
|
9
|
|
78
|
; |
|
9
|
|
|
|
|
28
|
|
1082
|
|
|
|
|
|
|
|
1083
|
|
|
|
|
|
|
sub _overload_space_ship { |
1084
|
3
|
50
|
|
3
|
|
659
|
defined $_[1] |
1085
|
|
|
|
|
|
|
or return undef; ## no critic (ProhibitExplicitReturnUndef) |
1086
|
3
|
50
|
|
|
|
20
|
return $_[2] ? - $_[0]->compare( $_[1] ) : $_[0]->compare( $_[1] ); |
1087
|
|
|
|
|
|
|
} |
1088
|
|
|
|
|
|
|
|
1089
|
|
|
|
|
|
|
sub _overload_cmp { |
1090
|
0
|
|
|
0
|
|
0
|
local $@ = undef; |
1091
|
0
|
0
|
|
|
|
0
|
eval { $_[1]->can( 'utc_rd_values' ) } |
|
0
|
|
|
|
|
0
|
|
1092
|
|
|
|
|
|
|
and goto &_overload_space_ship; |
1093
|
0
|
0
|
|
|
|
0
|
return ( "$_[0]" cmp "$_[1]" ) * ( $_[2] ? -1 : 1 ); |
1094
|
|
|
|
|
|
|
} |
1095
|
|
|
|
|
|
|
|
1096
|
|
|
|
|
|
|
sub _check_date { |
1097
|
67
|
|
|
67
|
|
178
|
my ( $arg ) = @_; |
1098
|
|
|
|
|
|
|
|
1099
|
67
|
100
|
|
|
|
207
|
if ( $arg->{holiday} ) { |
1100
|
|
|
|
|
|
|
$arg->{month} |
1101
|
24
|
50
|
|
|
|
64
|
and _croak( 'May not specify both holiday and month' ); |
1102
|
|
|
|
|
|
|
$arg->{day} |
1103
|
24
|
50
|
|
|
|
69
|
and _croak( 'May not specify both holiday and day' ); |
1104
|
|
|
|
|
|
|
} |
1105
|
|
|
|
|
|
|
|
1106
|
67
|
|
|
|
|
129
|
return; |
1107
|
|
|
|
|
|
|
} |
1108
|
|
|
|
|
|
|
|
1109
|
|
|
|
|
|
|
sub _stringify { |
1110
|
4
|
|
|
4
|
|
1733
|
splice @_, 1, $#_, '%Ex'; |
1111
|
4
|
|
|
|
|
23
|
goto &strftime; |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
sub on_date { |
1115
|
12
|
|
|
12
|
1
|
53
|
splice @_, 1, $#_, '%Ex%n%En%Ed'; |
1116
|
12
|
|
|
|
|
51
|
goto &strftime; |
1117
|
|
|
|
|
|
|
} |
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
# sub hour; sub minute; sub min; sub second; sub sec; sub nanosecond; |
1120
|
|
|
|
|
|
|
# sub hour_1; sub hour_12; sub hour_12_0; |
1121
|
|
|
|
|
|
|
# sub fractional_second; sub millisecond; sub microsecond; |
1122
|
|
|
|
|
|
|
# sub time_zone; sub time_zone_long_name; sub time_zone_short_name |
1123
|
|
|
|
|
|
|
# sub epoch; sub hires_epoch; sub utc_rd_values; sub utc_rd_as_seconds; |
1124
|
|
|
|
|
|
|
# sub set_formatter; sub offset; sub locale; sub set_locale; |
1125
|
|
|
|
|
|
|
# sub mjd; sub jd; |
1126
|
|
|
|
|
|
|
# sub is_dst; sub is_finite; sub is_infinite; sub leap_seconds; |
1127
|
|
|
|
|
|
|
# sub formatter; sub utc_year; |
1128
|
|
|
|
|
|
|
# sub local_rd_as_seconds; sub local_rd_values; |
1129
|
|
|
|
|
|
|
foreach my $method ( qw{ |
1130
|
|
|
|
|
|
|
hour minute min second sec nanosecond |
1131
|
|
|
|
|
|
|
hour_1 hour_12 hour_12_0 |
1132
|
|
|
|
|
|
|
fractional_second millisecond microsecond |
1133
|
|
|
|
|
|
|
time_zone time_zone_long_name time_zone_short_name |
1134
|
|
|
|
|
|
|
epoch hires_epoch utc_rd_values utc_rd_as_seconds |
1135
|
|
|
|
|
|
|
set_formatter offset locale set_locale |
1136
|
|
|
|
|
|
|
mjd jd |
1137
|
|
|
|
|
|
|
is_dst is_finite is_infinite leap_seconds |
1138
|
|
|
|
|
|
|
formatter utc_year |
1139
|
|
|
|
|
|
|
local_rd_as_seconds local_rd_values |
1140
|
|
|
|
|
|
|
} ) { |
1141
|
9
|
|
|
9
|
|
4199
|
no strict qw{ refs }; |
|
9
|
|
|
|
|
24
|
|
|
9
|
|
|
|
|
5541
|
|
1142
|
|
|
|
|
|
|
*$method = sub { |
1143
|
152
|
|
|
152
|
|
6103
|
my ( $self, @arg ) = @_; |
1144
|
152
|
|
|
|
|
594
|
return $self->{dt}->$method( @arg ) |
1145
|
|
|
|
|
|
|
}; |
1146
|
|
|
|
|
|
|
} |
1147
|
|
|
|
|
|
|
|
1148
|
|
|
|
|
|
|
*DefaultLocale = \&DateTime::DefaultLocale; |
1149
|
|
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
# These assume the corresponding DateTime routines only use the public |
1151
|
|
|
|
|
|
|
# interface. The last time I assumed that, second thoughts made me |
1152
|
|
|
|
|
|
|
# re-implement. We'll see how long this code stands. Though it may stand |
1153
|
|
|
|
|
|
|
# for a while, since the documentation also says that all that is needed |
1154
|
|
|
|
|
|
|
# is a utc_rd_values() method, which we have. |
1155
|
|
|
|
|
|
|
sub compare { |
1156
|
3
|
50
|
|
3
|
0
|
10
|
ref $_[0] |
1157
|
|
|
|
|
|
|
or shift @_; |
1158
|
3
|
|
|
|
|
19
|
return DateTime->compare( @_ ); |
1159
|
|
|
|
|
|
|
} |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
sub compare_ignore_floating { |
1162
|
0
|
0
|
|
0
|
0
|
0
|
ref $_[0] |
1163
|
|
|
|
|
|
|
or shift @_; |
1164
|
0
|
|
|
|
|
0
|
return DateTime->compare_ignore_floating( @_ ); |
1165
|
|
|
|
|
|
|
} |
1166
|
|
|
|
|
|
|
|
1167
|
|
|
|
|
|
|
# NOTE: I do not feel the need to load Storable, because if these are |
1168
|
|
|
|
|
|
|
# being called it has already been loaded. Either that or somebody is |
1169
|
|
|
|
|
|
|
# mucking around in the internals, in which case they are on their own. |
1170
|
|
|
|
|
|
|
sub STORABLE_freeze { |
1171
|
4
|
|
|
4
|
0
|
78
|
my ( $self ) = @_; |
1172
|
|
|
|
|
|
|
return Storable::freeze( |
1173
|
|
|
|
|
|
|
{ |
1174
|
|
|
|
|
|
|
accented => $self->{accented}, |
1175
|
|
|
|
|
|
|
traditional => $self->{traditional}, |
1176
|
|
|
|
|
|
|
}, |
1177
|
|
|
|
|
|
|
), |
1178
|
|
|
|
|
|
|
$self->{dt}, |
1179
|
4
|
|
|
|
|
21
|
}; |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
sub STORABLE_thaw { |
1182
|
4
|
|
|
4
|
0
|
4814
|
my ( $self, undef, $serialized, $dt ) = @_; |
1183
|
4
|
|
|
|
|
9
|
%{ $self } = %{ Storable::thaw( $serialized ) }; |
|
4
|
|
|
|
|
95
|
|
|
4
|
|
|
|
|
14
|
|
1184
|
4
|
|
|
|
|
16
|
$self->{dt} = $dt; |
1185
|
4
|
|
|
|
|
7
|
$self->{recalc} = 1; |
1186
|
4
|
|
|
|
|
33
|
return $self; |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
# Date::Tolkien::Shire::Data::__format() interface. |
1190
|
|
|
|
|
|
|
|
1191
|
|
|
|
|
|
|
*__fmt_shire_year = \&year; # sub __fmt_shire_year |
1192
|
|
|
|
|
|
|
*__fmt_shire_month = \&month; # sub __fmt_shire_month; |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
sub __fmt_shire_day { |
1195
|
89
|
|
|
89
|
|
3032
|
my ( $self ) = @_; |
1196
|
89
|
50
|
|
|
|
237
|
$self->_recalc_Shire if $self->{recalc}; |
1197
|
89
|
|
66
|
|
|
368
|
return $self->{day} || $self->{holiday}; |
1198
|
|
|
|
|
|
|
} |
1199
|
|
|
|
|
|
|
|
1200
|
|
|
|
|
|
|
*__fmt_shire_day_of_week = \&day_of_week; # sub __fmt_shire_day_of_week |
1201
|
|
|
|
|
|
|
*__fmt_shire_hour = \&hour; # sub __fmt_shire_hour; |
1202
|
|
|
|
|
|
|
*__fmt_shire_minute = \&minute; # sub __fmt_shire_minute; |
1203
|
|
|
|
|
|
|
*__fmt_shire_second = \&second; # sub __fmt_shire_second; |
1204
|
|
|
|
|
|
|
*__fmt_shire_nanosecond = \&nanosecond; # sub __fmt_shire_nanosecond; |
1205
|
|
|
|
|
|
|
*__fmt_shire_epoch = \&epoch; # sub __fmt_shire_epoch; |
1206
|
|
|
|
|
|
|
*__fmt_shire_zone_offset = \&offset; # sub __fmt_shire_zone_offset; |
1207
|
|
|
|
|
|
|
*__fmt_shire_zone_name = \&time_zone_short_name; # sub __fmt_shire_zone_name; |
1208
|
|
|
|
|
|
|
*__fmt_shire_accented = \&accented; # sub __fmt_shire_accented; |
1209
|
|
|
|
|
|
|
*__fmt_shire_traditional = \&traditional; # sub __fmt_shire_traditional |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
# sub day_of_month_0; sub day_0; sub mday_0; |
1212
|
|
|
|
|
|
|
# sub day_of_year_0; sub doy_0; |
1213
|
|
|
|
|
|
|
# sub quarter_0; sub day_of_quarter_0; sub doq_0; |
1214
|
|
|
|
|
|
|
# sub day_of_week_0; sub wday_0; sub dow_0; |
1215
|
|
|
|
|
|
|
# sub month_0; sub mon_0; |
1216
|
|
|
|
|
|
|
foreach my $method ( qw{ |
1217
|
|
|
|
|
|
|
day_of_month day mday |
1218
|
|
|
|
|
|
|
day_of_year doy |
1219
|
|
|
|
|
|
|
quarter day_of_quarter doq |
1220
|
|
|
|
|
|
|
day_of_week wday dow |
1221
|
|
|
|
|
|
|
month mon |
1222
|
|
|
|
|
|
|
} ) { |
1223
|
|
|
|
|
|
|
my $method_0 = $method . '_0'; |
1224
|
9
|
|
|
9
|
|
80
|
no strict qw{ refs }; |
|
9
|
|
|
|
|
26
|
|
|
9
|
|
|
|
|
2590
|
|
1225
|
5
|
|
|
5
|
|
1410
|
*$method_0 = sub { $_[0]->$method() - 1 }; |
1226
|
|
|
|
|
|
|
} |
1227
|
|
|
|
|
|
|
|
1228
|
|
|
|
|
|
|
sub _croak { |
1229
|
0
|
|
|
0
|
|
0
|
my @msg = @_; |
1230
|
0
|
|
|
|
|
0
|
Carp::croak( __PACKAGE__ . ": @msg" ); |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
|
1233
|
5
|
|
33
|
5
|
|
50
|
sub _isa { return Scalar::Util::blessed( $_[0] ) && $_[0]->isa( $_[1] ) } |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
1; |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
__END__ |
1238
|
|
|
|
|
|
|
|
1239
|
|
|
|
|
|
|
=head1 NAME |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
DateTime::Fiction::JRRTolkien::Shire - DateTime implementation of the Shire calendar. |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
=head1 SYNOPSIS |
1244
|
|
|
|
|
|
|
|
1245
|
|
|
|
|
|
|
use DateTime::Fiction::JRRTolkien::Shire; |
1246
|
|
|
|
|
|
|
|
1247
|
|
|
|
|
|
|
# Constructors |
1248
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->new(year => 1419, |
1249
|
|
|
|
|
|
|
month => 'Rethe', |
1250
|
|
|
|
|
|
|
day => 25); |
1251
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->new(year => 1419, |
1252
|
|
|
|
|
|
|
month => 3, |
1253
|
|
|
|
|
|
|
day => 25); |
1254
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->new(year => 1419, |
1255
|
|
|
|
|
|
|
holiday => '2 Lithe'); |
1256
|
|
|
|
|
|
|
|
1257
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->from_epoch( |
1258
|
|
|
|
|
|
|
epoch = $time); |
1259
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->today; |
1260
|
|
|
|
|
|
|
# same as from_epoch(epoch = time()); |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->from_object( |
1263
|
|
|
|
|
|
|
object => $some_other_DateTime_object); |
1264
|
|
|
|
|
|
|
my $shire = DateTime::Fiction::JRRTolkien::Shire->from_day_of_year( |
1265
|
|
|
|
|
|
|
year => 1420, |
1266
|
|
|
|
|
|
|
day_of_year => 182); |
1267
|
|
|
|
|
|
|
my $shire2 = $shire->clone; |
1268
|
|
|
|
|
|
|
|
1269
|
|
|
|
|
|
|
# Accessors |
1270
|
|
|
|
|
|
|
$year = $shire->year; |
1271
|
|
|
|
|
|
|
$month = $shire->month; # 1 - 12, or 0 on a holiday |
1272
|
|
|
|
|
|
|
$month_name = $shire->month_name; |
1273
|
|
|
|
|
|
|
$day = $shire->day; # 1 - 30, or 0 on a holiday |
1274
|
|
|
|
|
|
|
|
1275
|
|
|
|
|
|
|
$dow = $shire->day_of_week; # 1 - 7, or 0 on certain holidays |
1276
|
|
|
|
|
|
|
$day_name = $shire->day_name; |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
$holiday = $shire->holiday; |
1279
|
|
|
|
|
|
|
$holiday_name = $shire->holiday_name; |
1280
|
|
|
|
|
|
|
|
1281
|
|
|
|
|
|
|
$leap = $shire->is_leap_year; |
1282
|
|
|
|
|
|
|
|
1283
|
|
|
|
|
|
|
$time = $shire->epoch; |
1284
|
|
|
|
|
|
|
@rd = $shire->utc_rd_values; |
1285
|
|
|
|
|
|
|
|
1286
|
|
|
|
|
|
|
# Set Methods |
1287
|
|
|
|
|
|
|
$shire->set(year => 7463, |
1288
|
|
|
|
|
|
|
month => 5, |
1289
|
|
|
|
|
|
|
day => 3); |
1290
|
|
|
|
|
|
|
$shire->set(year => 7463, |
1291
|
|
|
|
|
|
|
holiday => 6); |
1292
|
|
|
|
|
|
|
$shire->truncate(to => 'month'); |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
# Comparisons |
1295
|
|
|
|
|
|
|
$shire < $shire2; |
1296
|
|
|
|
|
|
|
$shire == $shire2; |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
# Strings |
1299
|
|
|
|
|
|
|
print "$shire1\n"; # Prints Sunday 25 Rethe 1419 |
1300
|
|
|
|
|
|
|
|
1301
|
|
|
|
|
|
|
# On this date in history |
1302
|
|
|
|
|
|
|
print $shire->on_date; |
1303
|
|
|
|
|
|
|
|
1304
|
|
|
|
|
|
|
=head1 DESCRIPTION |
1305
|
|
|
|
|
|
|
|
1306
|
|
|
|
|
|
|
Implementation of the calendar used by the hobbits in J.R.R. Tolkien's |
1307
|
|
|
|
|
|
|
exceptional novel The Lord of The Rings, as described in Appendix D of |
1308
|
|
|
|
|
|
|
that book (except where noted). The calendar has 12 months, each with |
1309
|
|
|
|
|
|
|
30 days, and 5 holidays that are not part of any month. A sixth |
1310
|
|
|
|
|
|
|
holiday, Overlithe, is added on leap years. The holiday Midyear's Day |
1311
|
|
|
|
|
|
|
(and the Overlithe on a leap year) is not part of any week, which means |
1312
|
|
|
|
|
|
|
that the year always starts on Sterday. |
1313
|
|
|
|
|
|
|
|
1314
|
|
|
|
|
|
|
This module is a follow-on to the |
1315
|
|
|
|
|
|
|
L<Date::Tolkien::Shire|Date::Tolkien::Shire> module, and is rewritten to |
1316
|
|
|
|
|
|
|
support Dave Rolsky and company's L<DateTime|DateTime> module. The |
1317
|
|
|
|
|
|
|
DateTime module must be installed for this module to work. |
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
This module provides support for most L<DateTime|DateTime> |
1320
|
|
|
|
|
|
|
functionality, with the known exception of C<format_cldr()>, which may |
1321
|
|
|
|
|
|
|
be added later. |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
Support for L<strftime()|/strftime> comes from |
1324
|
|
|
|
|
|
|
L<Date::Tolkien::Shire::Data|Date::Tolkien::Shire::Data>, and you should |
1325
|
|
|
|
|
|
|
see the documentation for that module for the details of the formatting |
1326
|
|
|
|
|
|
|
codes. |
1327
|
|
|
|
|
|
|
|
1328
|
|
|
|
|
|
|
Some assumptions have had to be made on how the |
1329
|
|
|
|
|
|
|
hobbits represent time. We have references to (e.g.) "nine o'clock" (in |
1330
|
|
|
|
|
|
|
the morning), which seem to imply they start the day at midnight. But |
1331
|
|
|
|
|
|
|
there appears to be nothing to say whether they used a 12- or 24-hour |
1332
|
|
|
|
|
|
|
clock. Default time formats (say, '%X') use a 12-hour clock because that |
1333
|
|
|
|
|
|
|
is the English system and Tolkien did not specify anything to the |
1334
|
|
|
|
|
|
|
contrary. |
1335
|
|
|
|
|
|
|
|
1336
|
|
|
|
|
|
|
Calendar quarters are not mentioned at all in any of Tolkien's writings |
1337
|
|
|
|
|
|
|
(that I can find -- Wyant), but are part of the L<DateTime|DateTime> |
1338
|
|
|
|
|
|
|
interface. This package implements a quarter as being exactly 13 weeks, |
1339
|
|
|
|
|
|
|
with Midyear's day and Overlithe not being part of any quarter, on no |
1340
|
|
|
|
|
|
|
better justification than that the present author thinks that is |
1341
|
|
|
|
|
|
|
consistent with the Shire's approach to horology. |
1342
|
|
|
|
|
|
|
|
1343
|
|
|
|
|
|
|
=head1 METHODS |
1344
|
|
|
|
|
|
|
|
1345
|
|
|
|
|
|
|
Most of these methods mimic their corresponding DateTime methods in |
1346
|
|
|
|
|
|
|
functionality. For additional information on these methods, see the |
1347
|
|
|
|
|
|
|
DateTime documentation. |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
=head2 Constructors |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=head3 new |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
my $dt_ring = DateTime::Fiction::JRRTolkien::Shire->new( |
1354
|
|
|
|
|
|
|
year => 1419, |
1355
|
|
|
|
|
|
|
month => 3, |
1356
|
|
|
|
|
|
|
day => 25, |
1357
|
|
|
|
|
|
|
); |
1358
|
|
|
|
|
|
|
my $dt_aa = DateTime::Fiction::JRRTolkien::Shire->new( |
1359
|
|
|
|
|
|
|
year => 1419, |
1360
|
|
|
|
|
|
|
holiday => 3, # Midyear's day |
1361
|
|
|
|
|
|
|
); |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
This method takes a year, month, and day parameter, or a year and |
1364
|
|
|
|
|
|
|
holiday parameter. The year can be any value. The month can be |
1365
|
|
|
|
|
|
|
specified with a string giving the name of the month (the same string |
1366
|
|
|
|
|
|
|
that would be returned by month_name, with the first letter capitalized |
1367
|
|
|
|
|
|
|
and the rest in lower case) or by giving the numerical value for the |
1368
|
|
|
|
|
|
|
month, between 1 and 12. The day should always be between 1 and 30. If |
1369
|
|
|
|
|
|
|
a holiday is given instead of a day and month, it should be the name of |
1370
|
|
|
|
|
|
|
the holiday as returned by holiday_name (with the first letter of each |
1371
|
|
|
|
|
|
|
word capitalized) or a value between 1 and 6. The 1 through 6 numbers |
1372
|
|
|
|
|
|
|
map to holidays as follows: |
1373
|
|
|
|
|
|
|
|
1374
|
|
|
|
|
|
|
1 => 2 Yule |
1375
|
|
|
|
|
|
|
2 => 1 Lithe |
1376
|
|
|
|
|
|
|
3 => Midyear's Day |
1377
|
|
|
|
|
|
|
4 => Overlithe # Leap years only |
1378
|
|
|
|
|
|
|
5 => 2 Lithe |
1379
|
|
|
|
|
|
|
6 => 1 Yule |
1380
|
|
|
|
|
|
|
|
1381
|
|
|
|
|
|
|
The C<new()> method will also take parameters for hour, minute, second, |
1382
|
|
|
|
|
|
|
nanosecond, time_zone and locale. If given, these parameters will be |
1383
|
|
|
|
|
|
|
stored in case the object is converted to another class that makes use |
1384
|
|
|
|
|
|
|
of these attributes. |
1385
|
|
|
|
|
|
|
|
1386
|
|
|
|
|
|
|
Additionally, parameters C<accented> and C<traditional> control the form |
1387
|
|
|
|
|
|
|
of C<on_date()> text (accented or not) and week day names (traditional |
1388
|
|
|
|
|
|
|
or common) generated. These must be C<undef>, C<''>, or C<0> (for false) |
1389
|
|
|
|
|
|
|
or C<1> (for true). |
1390
|
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
|
If a day is not given, it will default to 1. If neither a day or month |
1392
|
|
|
|
|
|
|
is given, the date will default to 2 Yule, the first day of the year. |
1393
|
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
|
=head3 from_epoch |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->from_epoch( |
1397
|
|
|
|
|
|
|
epoch => time, |
1398
|
|
|
|
|
|
|
... |
1399
|
|
|
|
|
|
|
); |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
Same as in DateTime, but you can also specify parameters C<accented> and |
1402
|
|
|
|
|
|
|
C<traditional> (see L<new()|/new>). |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
=head3 now |
1405
|
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->now( ... ); |
1407
|
|
|
|
|
|
|
|
1408
|
|
|
|
|
|
|
Same as in DateTime, but you can also specify parameters C<accented> and |
1409
|
|
|
|
|
|
|
C<traditional> (see L<new()|/new>). Note that this is equivalent to |
1410
|
|
|
|
|
|
|
|
1411
|
|
|
|
|
|
|
from_epoch( epoch => time() ); |
1412
|
|
|
|
|
|
|
|
1413
|
|
|
|
|
|
|
and produces an object whose time zone is C<UTC>. |
1414
|
|
|
|
|
|
|
|
1415
|
|
|
|
|
|
|
=head3 now_local |
1416
|
|
|
|
|
|
|
|
1417
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->now_local( ... ); |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
This static method creates a new object set to the current local time. |
1420
|
|
|
|
|
|
|
Under the hood it just calls the C<localtime()> built-in, and then calls |
1421
|
|
|
|
|
|
|
L<new()|/new> with the results. Unlike L<now()|/now>, this method |
1422
|
|
|
|
|
|
|
produces an object whose zone is C<floating>. |
1423
|
|
|
|
|
|
|
|
1424
|
|
|
|
|
|
|
=head3 today |
1425
|
|
|
|
|
|
|
|
1426
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->today( ... ); |
1427
|
|
|
|
|
|
|
|
1428
|
|
|
|
|
|
|
Same as in DateTime, but you can also specify parameters C<accented> and |
1429
|
|
|
|
|
|
|
C<traditional> (see L<new()|/new>). |
1430
|
|
|
|
|
|
|
|
1431
|
|
|
|
|
|
|
=head3 from_object |
1432
|
|
|
|
|
|
|
|
1433
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->from_object( |
1434
|
|
|
|
|
|
|
object => $object, |
1435
|
|
|
|
|
|
|
... |
1436
|
|
|
|
|
|
|
); |
1437
|
|
|
|
|
|
|
|
1438
|
|
|
|
|
|
|
Same as in DateTime, but you can also specify parameters C<accented> and |
1439
|
|
|
|
|
|
|
C<traditional> (see L<new()|/new>). Takes any other DateTime calendar |
1440
|
|
|
|
|
|
|
object and converts it to a DateTime::Fiction::JRRTolkien::Shire object. |
1441
|
|
|
|
|
|
|
|
1442
|
|
|
|
|
|
|
=head3 last_day_of_month |
1443
|
|
|
|
|
|
|
|
1444
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->last_day_of_month( |
1445
|
|
|
|
|
|
|
year => 1419, |
1446
|
|
|
|
|
|
|
month => 3, |
1447
|
|
|
|
|
|
|
... |
1448
|
|
|
|
|
|
|
); |
1449
|
|
|
|
|
|
|
|
1450
|
|
|
|
|
|
|
Same as in DateTime. Like the C<new()> constructor, but it does not |
1451
|
|
|
|
|
|
|
take a day parameter. Instead, the day is set to 30, which is the last |
1452
|
|
|
|
|
|
|
day of any month in the shire calendar. A holiday parameter should not |
1453
|
|
|
|
|
|
|
be used with this method. Use L<new()|/new> instead. |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=head3 from_day_of_year |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
$dts = DateTime::Fiction::JRRTolkien::Shire->from_day_of_year( |
1458
|
|
|
|
|
|
|
year => 1419, |
1459
|
|
|
|
|
|
|
day_of_year => 86, |
1460
|
|
|
|
|
|
|
... |
1461
|
|
|
|
|
|
|
); |
1462
|
|
|
|
|
|
|
|
1463
|
|
|
|
|
|
|
Same as in DateTime. Gets the date from the given year and day of year, |
1464
|
|
|
|
|
|
|
both of which must be given. Hour, minute, second, time_zone, etc. |
1465
|
|
|
|
|
|
|
parameters may also be given, and will be passed to the underlying |
1466
|
|
|
|
|
|
|
DateTime object, just like in C<new()>. |
1467
|
|
|
|
|
|
|
|
1468
|
|
|
|
|
|
|
=head3 clone |
1469
|
|
|
|
|
|
|
|
1470
|
|
|
|
|
|
|
$dts2 = $dts->clone(); |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
Creates a new Shire object that is the same date (and underlying time) |
1473
|
|
|
|
|
|
|
as the calling object. |
1474
|
|
|
|
|
|
|
|
1475
|
|
|
|
|
|
|
=head2 "Get" Methods |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
=head3 calendar_name |
1478
|
|
|
|
|
|
|
|
1479
|
|
|
|
|
|
|
print $dts->calendar_name(), "\n"; |
1480
|
|
|
|
|
|
|
|
1481
|
|
|
|
|
|
|
Returns C<'Shire'>. |
1482
|
|
|
|
|
|
|
|
1483
|
|
|
|
|
|
|
=head3 year |
1484
|
|
|
|
|
|
|
|
1485
|
|
|
|
|
|
|
print 'Year: ', $dts->year(), "\n"; |
1486
|
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
|
Returns the year. |
1488
|
|
|
|
|
|
|
|
1489
|
|
|
|
|
|
|
=head3 month |
1490
|
|
|
|
|
|
|
|
1491
|
|
|
|
|
|
|
print 'Month: ', $dts->month(), "\n"; |
1492
|
|
|
|
|
|
|
|
1493
|
|
|
|
|
|
|
Returns the month number, from 1 to 12. If the date is a holiday, a 0 |
1494
|
|
|
|
|
|
|
is returned for the month. |
1495
|
|
|
|
|
|
|
|
1496
|
|
|
|
|
|
|
=head3 mon |
1497
|
|
|
|
|
|
|
|
1498
|
|
|
|
|
|
|
Synonym for L<month()|/month>. |
1499
|
|
|
|
|
|
|
|
1500
|
|
|
|
|
|
|
=head3 month_name |
1501
|
|
|
|
|
|
|
|
1502
|
|
|
|
|
|
|
print 'Month name: ', $dts->month_name(), "\n"; |
1503
|
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
|
Returns the name of the month. If the date is a holiday, an empty |
1505
|
|
|
|
|
|
|
string is returned. |
1506
|
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
|
=head3 day_of_month |
1508
|
|
|
|
|
|
|
|
1509
|
|
|
|
|
|
|
print 'Day of month: ', $dts->day_of_month(), "\n"; |
1510
|
|
|
|
|
|
|
|
1511
|
|
|
|
|
|
|
Returns the day of the current month, from 1 to 30. If the date is a |
1512
|
|
|
|
|
|
|
holiday, 0 is returned. |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
=head3 day |
1515
|
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
|
Synonym for L<day_of_month()|/day_of_month>. |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
=head3 mday |
1519
|
|
|
|
|
|
|
|
1520
|
|
|
|
|
|
|
Synonym for L<day_of_month()|/day_of_month>. |
1521
|
|
|
|
|
|
|
|
1522
|
|
|
|
|
|
|
=head3 day_of_week |
1523
|
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
|
print 'Day of week: ', $dts->day_of_week(), "\n"; |
1525
|
|
|
|
|
|
|
|
1526
|
|
|
|
|
|
|
Returns the day of the week from 1 to 7. If the day is not part of |
1527
|
|
|
|
|
|
|
any week (Midyear's Day or the Overlithe), 0 is returned. |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
=head3 wday |
1530
|
|
|
|
|
|
|
|
1531
|
|
|
|
|
|
|
Synonym for L<day_of_week|/day_of_week>. |
1532
|
|
|
|
|
|
|
|
1533
|
|
|
|
|
|
|
=head3 dow |
1534
|
|
|
|
|
|
|
|
1535
|
|
|
|
|
|
|
Synonym for L<day_of_week|/day_of_week>. |
1536
|
|
|
|
|
|
|
|
1537
|
|
|
|
|
|
|
=head3 day_name |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
print 'Common name of day of week: ', |
1540
|
|
|
|
|
|
|
$dts->day_name(), "\n"; |
1541
|
|
|
|
|
|
|
|
1542
|
|
|
|
|
|
|
Returns the common name of the day of the week, or an empty string if |
1543
|
|
|
|
|
|
|
the day is not part of any week. This method is not affected by the |
1544
|
|
|
|
|
|
|
L<traditional()|/traditional> setting, for historical reasons. |
1545
|
|
|
|
|
|
|
|
1546
|
|
|
|
|
|
|
=head3 day_name_trad |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
print 'Traditional name of day of week: ', |
1549
|
|
|
|
|
|
|
$dts->day_name_trad(), "\n"; |
1550
|
|
|
|
|
|
|
|
1551
|
|
|
|
|
|
|
Returns the common name of the day of the week, or an empty string if |
1552
|
|
|
|
|
|
|
the day is not part of any week. This method is not affected by the |
1553
|
|
|
|
|
|
|
L<traditional()|/traditional> setting, for historical reasons. |
1554
|
|
|
|
|
|
|
|
1555
|
|
|
|
|
|
|
=head3 day_abbr |
1556
|
|
|
|
|
|
|
|
1557
|
|
|
|
|
|
|
print 'Common abbreviation of day of week: ', |
1558
|
|
|
|
|
|
|
$dts->day_abbr(), "\n"; |
1559
|
|
|
|
|
|
|
|
1560
|
|
|
|
|
|
|
Returns the common abbreviation of the day of the week, or an empty |
1561
|
|
|
|
|
|
|
string if the day is not part of any week. This method is not affected |
1562
|
|
|
|
|
|
|
by the L<traditional()|/traditional> setting, for consistency with |
1563
|
|
|
|
|
|
|
L<day_name()|/day_name>. |
1564
|
|
|
|
|
|
|
|
1565
|
|
|
|
|
|
|
=head3 day_abbr_trad |
1566
|
|
|
|
|
|
|
|
1567
|
|
|
|
|
|
|
print 'Traditional abbreviation of day of week: ', |
1568
|
|
|
|
|
|
|
$dts->day_abbr_trad(), "\n"; |
1569
|
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
|
Returns the traditional abbreviation of the day of the week, or an empty |
1571
|
|
|
|
|
|
|
string if the day is not part of any week. This method is not affected |
1572
|
|
|
|
|
|
|
by the L<traditional()|/traditional> setting, for consistency with |
1573
|
|
|
|
|
|
|
L<day_name_trad()|/day_name_trad>. |
1574
|
|
|
|
|
|
|
|
1575
|
|
|
|
|
|
|
=head3 day_of_year |
1576
|
|
|
|
|
|
|
|
1577
|
|
|
|
|
|
|
print 'Day of year: ', $dts->day_of_year(), "\n"; |
1578
|
|
|
|
|
|
|
|
1579
|
|
|
|
|
|
|
Returns the day of the year, from 1 to 366 |
1580
|
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
|
=head3 doy |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
Synonym for L<day_of_year()|/day_of_year>. |
1584
|
|
|
|
|
|
|
|
1585
|
|
|
|
|
|
|
=head3 holiday |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
print 'Holiday number: ', $dts->holiday(), "\n"; |
1588
|
|
|
|
|
|
|
|
1589
|
|
|
|
|
|
|
Returns the holiday number (given in the description of the |
1590
|
|
|
|
|
|
|
L<new()|/new> constructor). If the day is not a holiday, 0 is returned. |
1591
|
|
|
|
|
|
|
|
1592
|
|
|
|
|
|
|
=head3 holiday_name |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
print 'Holiday name: ', $dts->holiday_name(), "\n"; |
1595
|
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
|
Returns the name of the holiday. If the day is not a holiday, an empty |
1597
|
|
|
|
|
|
|
string is returned. |
1598
|
|
|
|
|
|
|
|
1599
|
|
|
|
|
|
|
=head3 holiday_abbr |
1600
|
|
|
|
|
|
|
|
1601
|
|
|
|
|
|
|
print 'Holiday abbreviation: ', $dts->holiday_abbr(), "\n"; |
1602
|
|
|
|
|
|
|
|
1603
|
|
|
|
|
|
|
Returns the abbreviation of the holiday. If the day is not a holiday, an |
1604
|
|
|
|
|
|
|
empty string is returned. |
1605
|
|
|
|
|
|
|
|
1606
|
|
|
|
|
|
|
=head3 is_leap_year |
1607
|
|
|
|
|
|
|
|
1608
|
|
|
|
|
|
|
my @ly = ( 'is not', 'is' ); |
1609
|
|
|
|
|
|
|
printf "%d %s a leap year\n", $dts->year(), |
1610
|
|
|
|
|
|
|
$ly[ $dts->is_leap_year() ]; |
1611
|
|
|
|
|
|
|
|
1612
|
|
|
|
|
|
|
Returns 1 if the year is a leap year, and 0 otherwise. |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
Leap years are given the same rule as the Gregorian calendar. Every |
1615
|
|
|
|
|
|
|
four years is a leap year, except the first year of the century, which |
1616
|
|
|
|
|
|
|
is not a leap year. However, every fourth century (400 years), the |
1617
|
|
|
|
|
|
|
first year of the century is a leap year (every 4, except every 100, |
1618
|
|
|
|
|
|
|
except every 400). This is a slight change from the calendar described |
1619
|
|
|
|
|
|
|
in Appendix D, which uses the rule of once every 4 years, except every |
1620
|
|
|
|
|
|
|
100 years (the same as in the Julian calendar). Given some uncertainty |
1621
|
|
|
|
|
|
|
about how many years have passed since the time in Lord of the Rings |
1622
|
|
|
|
|
|
|
(see note below), and the expectations of most people that the years |
1623
|
|
|
|
|
|
|
match up with what they're used to, I have changed this rule for this |
1624
|
|
|
|
|
|
|
implementation. However, this does mean that this calendar |
1625
|
|
|
|
|
|
|
implementation is not strictly that described in Appendix D. |
1626
|
|
|
|
|
|
|
|
1627
|
|
|
|
|
|
|
=head3 week_year |
1628
|
|
|
|
|
|
|
|
1629
|
|
|
|
|
|
|
print 'The week year is ', $dts->week_year(), "\n"; |
1630
|
|
|
|
|
|
|
|
1631
|
|
|
|
|
|
|
This is always the same as the year in the shire calendar, but is |
1632
|
|
|
|
|
|
|
present for compatibility with other DateTime objects. |
1633
|
|
|
|
|
|
|
|
1634
|
|
|
|
|
|
|
=head3 week_number |
1635
|
|
|
|
|
|
|
|
1636
|
|
|
|
|
|
|
print 'The week number is ', $dts->week_number(), "\n"; |
1637
|
|
|
|
|
|
|
|
1638
|
|
|
|
|
|
|
Returns the week of the year, or C<0> for days that are not part of any |
1639
|
|
|
|
|
|
|
week: Midyear's day and the Overlithe. |
1640
|
|
|
|
|
|
|
|
1641
|
|
|
|
|
|
|
=head3 week |
1642
|
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
|
printf "Year %d; Week number %d\n", $dts->week(); |
1644
|
|
|
|
|
|
|
|
1645
|
|
|
|
|
|
|
Returns a two element array, where the first is the week_year and the |
1646
|
|
|
|
|
|
|
latter is the week_number. |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
=head3 weekday_of_month |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
Same as L<DateTime|DateTime>, but returns C<0> for a holiday. |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
=head3 week_of_month |
1653
|
|
|
|
|
|
|
|
1654
|
|
|
|
|
|
|
Same as L<DateTime|DateTime>, but returns nothing (C<undef> in scalar |
1655
|
|
|
|
|
|
|
context) for a holiday. The return for a holiday can not be C<0>, |
1656
|
|
|
|
|
|
|
because this is a valid return, e.g. for 1 Rethe. |
1657
|
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
|
=head3 epoch |
1659
|
|
|
|
|
|
|
|
1660
|
|
|
|
|
|
|
print scalar gmtime $dts->epoch(), "UT\n"; |
1661
|
|
|
|
|
|
|
|
1662
|
|
|
|
|
|
|
Returns the epoch of the given object, just like in DateTime. |
1663
|
|
|
|
|
|
|
|
1664
|
|
|
|
|
|
|
=head3 hires_epoch |
1665
|
|
|
|
|
|
|
|
1666
|
|
|
|
|
|
|
Returns the epoch as a floating point number, with the fractional |
1667
|
|
|
|
|
|
|
portion for fractional seconds. Functions the same as in DateTime. |
1668
|
|
|
|
|
|
|
|
1669
|
|
|
|
|
|
|
=head3 quarter |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
Returns the number of the quarter the day is in, in the range 1 to 4. If |
1672
|
|
|
|
|
|
|
the day is part of no quarter (Midyear's day and the Overlithe), returns |
1673
|
|
|
|
|
|
|
0. |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
There is no textual justification for quarters, but they are in the |
1676
|
|
|
|
|
|
|
L<DateTime|DateTime> interface, so I rationalized the concept the same |
1677
|
|
|
|
|
|
|
way the Shire calendar rationalizes weeks. If you are not interested in |
1678
|
|
|
|
|
|
|
non-canonical functionality, please ignore anything involving quarters. |
1679
|
|
|
|
|
|
|
|
1680
|
|
|
|
|
|
|
=head3 quarter_0 |
1681
|
|
|
|
|
|
|
|
1682
|
|
|
|
|
|
|
Returns the number of the quarter the day is in, in the range 0 to 3. If |
1683
|
|
|
|
|
|
|
the day is part of no quarter (Midyear's day and the Overlithe), returns |
1684
|
|
|
|
|
|
|
-1. |
1685
|
|
|
|
|
|
|
|
1686
|
|
|
|
|
|
|
=head3 quarter_name |
1687
|
|
|
|
|
|
|
|
1688
|
|
|
|
|
|
|
Returns the name of the quarter. |
1689
|
|
|
|
|
|
|
|
1690
|
|
|
|
|
|
|
=head3 quarter_abbr |
1691
|
|
|
|
|
|
|
|
1692
|
|
|
|
|
|
|
Returns the abbreviation of the quarter. |
1693
|
|
|
|
|
|
|
|
1694
|
|
|
|
|
|
|
=head3 day_of_quarter |
1695
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
Returns the day of the date in the quarter, in the range 1 to 91. If the |
1697
|
|
|
|
|
|
|
day is Midyear's day or the Overlithe, you get 1. |
1698
|
|
|
|
|
|
|
|
1699
|
|
|
|
|
|
|
=head3 era_name |
1700
|
|
|
|
|
|
|
|
1701
|
|
|
|
|
|
|
Returns either C<'Shire Reckoning'> if the year is positive, or |
1702
|
|
|
|
|
|
|
C<'Before Shire Reckoning'> otherwise. |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
=head3 era_abbr |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
Returns either C<'SR'> if the year is positive, or C<'BSR'> otherwise. |
1707
|
|
|
|
|
|
|
|
1708
|
|
|
|
|
|
|
=head3 christian_era |
1709
|
|
|
|
|
|
|
|
1710
|
|
|
|
|
|
|
This really does not apply to the Shire calendar, but it is part of the |
1711
|
|
|
|
|
|
|
L<DateTime|DateTime> interface. Despite its name, it returns the same |
1712
|
|
|
|
|
|
|
thing that L<era_abbr()|/era_abbr> does. |
1713
|
|
|
|
|
|
|
|
1714
|
|
|
|
|
|
|
=head3 secular_era |
1715
|
|
|
|
|
|
|
|
1716
|
|
|
|
|
|
|
Returns the same thing L<era_abbr()|/era_abbr> does. |
1717
|
|
|
|
|
|
|
|
1718
|
|
|
|
|
|
|
=head3 utc_rd_values |
1719
|
|
|
|
|
|
|
|
1720
|
|
|
|
|
|
|
Returns the UTC rata die days, seconds, and nanoseconds. Ignores |
1721
|
|
|
|
|
|
|
fractional seconds. This is the standard method used by other methods |
1722
|
|
|
|
|
|
|
to convert the shire calendar to other calendars. See the DateTime |
1723
|
|
|
|
|
|
|
documentation for more information. |
1724
|
|
|
|
|
|
|
|
1725
|
|
|
|
|
|
|
=head3 utc_rd_as_seconds |
1726
|
|
|
|
|
|
|
|
1727
|
|
|
|
|
|
|
Returns the UTC rata die days entirely as seconds. |
1728
|
|
|
|
|
|
|
|
1729
|
|
|
|
|
|
|
=head3 on_date |
1730
|
|
|
|
|
|
|
|
1731
|
|
|
|
|
|
|
Returns the current day, with day of week if present, and with all names |
1732
|
|
|
|
|
|
|
in full. If the day has some events that transpired |
1733
|
|
|
|
|
|
|
on it (as defined in Appendix B of the Lord of the Rings), those events |
1734
|
|
|
|
|
|
|
are appended. This can be fun to put in a F<.bashrc> or F<.cshrc>. |
1735
|
|
|
|
|
|
|
Try |
1736
|
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
|
perl -MDateTime::Fiction::JRRTolkien::Shire |
1738
|
|
|
|
|
|
|
-le 'print DateTime::Fiction::JRRTolkien::Shire->now->on_date;' |
1739
|
|
|
|
|
|
|
|
1740
|
|
|
|
|
|
|
=head3 iso8601 |
1741
|
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
|
This is not, of course, a true ISO-8601 implementation. The differences |
1743
|
|
|
|
|
|
|
are that holidays are represented by their abbreviations (e.g. |
1744
|
|
|
|
|
|
|
C<'1419-Myd'>, and that the date and time are separated by the letter |
1745
|
|
|
|
|
|
|
C<'S'>, not C<'T'>. |
1746
|
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
|
=head3 strftime |
1748
|
|
|
|
|
|
|
|
1749
|
|
|
|
|
|
|
print $dts->strftime( '%Ex%n' ); |
1750
|
|
|
|
|
|
|
|
1751
|
|
|
|
|
|
|
This is a re-implementation imported from |
1752
|
|
|
|
|
|
|
L<Date::Tolkien::Shire::Data|Date::Tolkien::Shire::Data>. It is intended |
1753
|
|
|
|
|
|
|
to be reasonably compatible with the same-named L<DateTime|DateTime> |
1754
|
|
|
|
|
|
|
method, but has some additions to deal with the peculiarities of the |
1755
|
|
|
|
|
|
|
Shire calendar. |
1756
|
|
|
|
|
|
|
|
1757
|
|
|
|
|
|
|
See L<__format()|Date::Tolkien::Shire::Data/__format> in |
1758
|
|
|
|
|
|
|
L<Date::Tolkien::Shire::Data|Date::Tolkien::Shire::Data> for the |
1759
|
|
|
|
|
|
|
documentation, since that is the code that does the heavy lifting for |
1760
|
|
|
|
|
|
|
us. |
1761
|
|
|
|
|
|
|
|
1762
|
|
|
|
|
|
|
=head3 accented |
1763
|
|
|
|
|
|
|
|
1764
|
|
|
|
|
|
|
This method returns a true value if the event descriptions returned by |
1765
|
|
|
|
|
|
|
L<on_date()|/on_date> and L<strftime()|/strftime> are to be accented. |
1766
|
|
|
|
|
|
|
|
1767
|
|
|
|
|
|
|
=head3 traditional |
1768
|
|
|
|
|
|
|
|
1769
|
|
|
|
|
|
|
This method returns a true value if the dates returned by |
1770
|
|
|
|
|
|
|
L<on_date()|/on_date>, L<strftime()|/strftime>, and stringification are |
1771
|
|
|
|
|
|
|
to use traditional rather than common weekday names. |
1772
|
|
|
|
|
|
|
|
1773
|
|
|
|
|
|
|
=head2 "Set" Methods |
1774
|
|
|
|
|
|
|
|
1775
|
|
|
|
|
|
|
=head3 set |
1776
|
|
|
|
|
|
|
|
1777
|
|
|
|
|
|
|
$dts->set( |
1778
|
|
|
|
|
|
|
month => 3, |
1779
|
|
|
|
|
|
|
day => 25, |
1780
|
|
|
|
|
|
|
); |
1781
|
|
|
|
|
|
|
|
1782
|
|
|
|
|
|
|
Allows the day, month, and year to be changed. It takes any parameters |
1783
|
|
|
|
|
|
|
allowed by the L<new()|/new> constructor, including all those supported |
1784
|
|
|
|
|
|
|
by DateTime and the holiday parameter, except for time_zone. Any |
1785
|
|
|
|
|
|
|
parameters not given will be left as is. However, with holidays not |
1786
|
|
|
|
|
|
|
falling in any month, it is recommended that a day and month always be |
1787
|
|
|
|
|
|
|
given together. Otherwise, unanticipated results may occur. |
1788
|
|
|
|
|
|
|
|
1789
|
|
|
|
|
|
|
As in the L<new()|/new> constructor, time parameters have no effect on |
1790
|
|
|
|
|
|
|
the Shire dates returned. However, they are maintained in case the |
1791
|
|
|
|
|
|
|
object is converted to another calendar which supports time. |
1792
|
|
|
|
|
|
|
|
1793
|
|
|
|
|
|
|
All C<set_*()> methods from L<DateTime|DateTime> are provided. In |
1794
|
|
|
|
|
|
|
addition, you get the following: |
1795
|
|
|
|
|
|
|
|
1796
|
|
|
|
|
|
|
=head3 set_holiday |
1797
|
|
|
|
|
|
|
|
1798
|
|
|
|
|
|
|
This convenience method is implemented in terms of |
1799
|
|
|
|
|
|
|
|
1800
|
|
|
|
|
|
|
$dts->set( holiday => ... ); |
1801
|
|
|
|
|
|
|
|
1802
|
|
|
|
|
|
|
=head3 set_accented |
1803
|
|
|
|
|
|
|
|
1804
|
|
|
|
|
|
|
This convenience method is implemented in terms of |
1805
|
|
|
|
|
|
|
|
1806
|
|
|
|
|
|
|
$dts->set( accented => ... ); |
1807
|
|
|
|
|
|
|
|
1808
|
|
|
|
|
|
|
=head3 set_traditional |
1809
|
|
|
|
|
|
|
|
1810
|
|
|
|
|
|
|
This convenience method is implemented in terms of |
1811
|
|
|
|
|
|
|
|
1812
|
|
|
|
|
|
|
$dts->set( traditional => ... ); |
1813
|
|
|
|
|
|
|
|
1814
|
|
|
|
|
|
|
=head3 truncate |
1815
|
|
|
|
|
|
|
|
1816
|
|
|
|
|
|
|
$dts->truncate( to => 'day' ); |
1817
|
|
|
|
|
|
|
|
1818
|
|
|
|
|
|
|
Like the corresponding L<DateTime|DateTime> method, with the following |
1819
|
|
|
|
|
|
|
exceptions: |
1820
|
|
|
|
|
|
|
|
1821
|
|
|
|
|
|
|
If the date is a holiday, truncation to C<'month'> is equivalent to |
1822
|
|
|
|
|
|
|
truncation to C<'day'>, since holidays are not part of any month. |
1823
|
|
|
|
|
|
|
|
1824
|
|
|
|
|
|
|
Similarly, if the date is Midyear's day or the Overlithe, truncation to |
1825
|
|
|
|
|
|
|
C<'week'>, C<'local_week'>, or C<'quarter'> is equivalent to truncation |
1826
|
|
|
|
|
|
|
to C<'day'>, since these holidays are not part of any week (or, by |
1827
|
|
|
|
|
|
|
extension, quarter). |
1828
|
|
|
|
|
|
|
|
1829
|
|
|
|
|
|
|
The week in the Shire calendar begins on Sterday, so both C<'week'> and |
1830
|
|
|
|
|
|
|
C<'local_week'> truncate to that day. |
1831
|
|
|
|
|
|
|
|
1832
|
|
|
|
|
|
|
There is no textual justification for quarters, but they are in the |
1833
|
|
|
|
|
|
|
L<DateTime|DateTime> interface, so I rationalized the concept the same |
1834
|
|
|
|
|
|
|
way the Shire calendar rationalizes weeks. If you are not interested in |
1835
|
|
|
|
|
|
|
non-canonical functionality, please ignore anything involving quarters. |
1836
|
|
|
|
|
|
|
|
1837
|
|
|
|
|
|
|
=head3 set_time_zone |
1838
|
|
|
|
|
|
|
|
1839
|
|
|
|
|
|
|
$dts->set_time_zone( 'UTC' ); |
1840
|
|
|
|
|
|
|
|
1841
|
|
|
|
|
|
|
Just like in DateTime. This method has no effect on the shire calendar, |
1842
|
|
|
|
|
|
|
but be stored with the date if it is ever converted to another calendar |
1843
|
|
|
|
|
|
|
with time support. |
1844
|
|
|
|
|
|
|
|
1845
|
|
|
|
|
|
|
=head2 Comparisons and Stringification |
1846
|
|
|
|
|
|
|
|
1847
|
|
|
|
|
|
|
All comparison operators should work, just as in DateTime. In addition, |
1848
|
|
|
|
|
|
|
all C<DateTime::Fiction::JRRTolkien::Shire> objects will interpolate |
1849
|
|
|
|
|
|
|
into a string representing the date when used in a double-quoted string. |
1850
|
|
|
|
|
|
|
|
1851
|
|
|
|
|
|
|
=head2 Durations and Date Math |
1852
|
|
|
|
|
|
|
|
1853
|
|
|
|
|
|
|
Durations and date math are supported as of 0.900_01. |
1854
|
|
|
|
|
|
|
Because of the peculiarities of the Shire calendar, the relevant |
1855
|
|
|
|
|
|
|
duration object is |
1856
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration>, |
1857
|
|
|
|
|
|
|
which is B<not> a subclass of L<DateTime::Duration|DateTime::Duration>. |
1858
|
|
|
|
|
|
|
|
1859
|
|
|
|
|
|
|
The date portion of the math is done in the order L<month|/month>, |
1860
|
|
|
|
|
|
|
L<week|/week>, L<year|/year>, L<day|/day>. Before adding (or |
1861
|
|
|
|
|
|
|
subtracting) months or weeks from a date that is not part of any month |
1862
|
|
|
|
|
|
|
(or week), that date will be adjusted forward or backward to the nearest |
1863
|
|
|
|
|
|
|
date that is part of a month (or week). The direction of adjustment is |
1864
|
|
|
|
|
|
|
specified by the |
1865
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1866
|
|
|
|
|
|
|
object; see its documentation for the details. The order of operation |
1867
|
|
|
|
|
|
|
was chosen to ensure that only one such adjustment would be necessary |
1868
|
|
|
|
|
|
|
for any computation. |
1869
|
|
|
|
|
|
|
|
1870
|
|
|
|
|
|
|
=head3 add |
1871
|
|
|
|
|
|
|
|
1872
|
|
|
|
|
|
|
This convenience method takes as arguments either a |
1873
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1874
|
|
|
|
|
|
|
object or the arguments needed to manufacture one. The duration is then |
1875
|
|
|
|
|
|
|
passed to L<add_duration()|/add_duration>. |
1876
|
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
|
=head3 add_duration |
1878
|
|
|
|
|
|
|
|
1879
|
|
|
|
|
|
|
This method takes as its argument a |
1880
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1881
|
|
|
|
|
|
|
object. This is added to the invocant (i.e. it is a mutator). The |
1882
|
|
|
|
|
|
|
invocant is returned. |
1883
|
|
|
|
|
|
|
|
1884
|
|
|
|
|
|
|
=head3 subtract |
1885
|
|
|
|
|
|
|
|
1886
|
|
|
|
|
|
|
This convenience method takes as arguments either a |
1887
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1888
|
|
|
|
|
|
|
object or the arguments needed to manufacture one. The duration is then |
1889
|
|
|
|
|
|
|
passed to L<subtract_duration()|/subtract_duration>. |
1890
|
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
|
=head3 subtract_duration |
1892
|
|
|
|
|
|
|
|
1893
|
|
|
|
|
|
|
This convenience method takes as its argument a |
1894
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1895
|
|
|
|
|
|
|
object. The inverse of this object is then passed to |
1896
|
|
|
|
|
|
|
L<add_duration()|/add_duration>. |
1897
|
|
|
|
|
|
|
|
1898
|
|
|
|
|
|
|
=head3 subtract_datetime |
1899
|
|
|
|
|
|
|
|
1900
|
|
|
|
|
|
|
This takes as its argument a |
1901
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire|DateTime::Fiction::JRRTolkien::Shire> |
1902
|
|
|
|
|
|
|
object. The return is a |
1903
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire::Duration|DateTime::Fiction::JRRTolkien::Shire::Duration> |
1904
|
|
|
|
|
|
|
object representing the difference between the two objects. If either |
1905
|
|
|
|
|
|
|
the invocant or the argument represents a holiday, the date portion of |
1906
|
|
|
|
|
|
|
this difference will contain C<years> and C<days>. Otherwise it will |
1907
|
|
|
|
|
|
|
contain C<years>, C<months> and C<days>. |
1908
|
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
|
=head3 subtract_datetime_absolute, delta_days, delta_md, delta_ms |
1910
|
|
|
|
|
|
|
|
1911
|
|
|
|
|
|
|
These are just delegated to the corresponding L<DateTime|DateTime> |
1912
|
|
|
|
|
|
|
method. The argument can be either a |
1913
|
|
|
|
|
|
|
L<DateTime::Fiction::JRRTolkien::Shire|DateTime::Fiction::JRRTolkien::Shire> |
1914
|
|
|
|
|
|
|
object or a L<DateTime|DateTime> object. |
1915
|
|
|
|
|
|
|
|
1916
|
|
|
|
|
|
|
=head1 NOTE: YEAR CALCULATION |
1917
|
|
|
|
|
|
|
|
1918
|
|
|
|
|
|
|
L<http://www.glyphweb.com/arda/f/fourthage.html> references a letter sent |
1919
|
|
|
|
|
|
|
by Tolkien in 1958 in which he estimates approximately 6000 years have |
1920
|
|
|
|
|
|
|
passed since the War of the Ring and the end of the Third Age. (Thanks |
1921
|
|
|
|
|
|
|
to Danny O'Brien from sending me this link). I took this approximate as |
1922
|
|
|
|
|
|
|
an exact amount and calculated back 6000 years from 1958. This I set as |
1923
|
|
|
|
|
|
|
the start of the 4th age (1422 S.R.). Thus the fourth age begins in our |
1924
|
|
|
|
|
|
|
B.C 4042. |
1925
|
|
|
|
|
|
|
|
1926
|
|
|
|
|
|
|
According to Appendix D of the Lord of the Rings, leap years in the |
1927
|
|
|
|
|
|
|
hobbits' |
1928
|
|
|
|
|
|
|
calendar are every 4 years unless it is the turn of the century, in which |
1929
|
|
|
|
|
|
|
case it is not a leap year. Our calendar (Gregorian) uses every 4 years |
1930
|
|
|
|
|
|
|
unless it's 100 years unless its 400 years. So, if no changes have been |
1931
|
|
|
|
|
|
|
made to the hobbits' calendar since the end of the third age, their |
1932
|
|
|
|
|
|
|
calendar would be about 15 days further behind ours now than when the |
1933
|
|
|
|
|
|
|
War of the Ring took place. Implementing this seemed to me to go |
1934
|
|
|
|
|
|
|
against Tolkien's general habit of converting dates in the novel to our |
1935
|
|
|
|
|
|
|
equivalents to give us a better sense of time. My thought, at least |
1936
|
|
|
|
|
|
|
right now, is that it is truer to the spirit of things for years to line |
1937
|
|
|
|
|
|
|
up, and for Midyear's day to still be approximately on the summer |
1938
|
|
|
|
|
|
|
solstice. So instead, I have modified Tolkien's description of the |
1939
|
|
|
|
|
|
|
hobbit calendar so that leap years occur once every 4 years unless it's |
1940
|
|
|
|
|
|
|
100 years unless it's 400 years, so as it matches the Gregorian calendar |
1941
|
|
|
|
|
|
|
in that regard. These 100 and 400 year intervals occur at different |
1942
|
|
|
|
|
|
|
times in the two calendars, so there is not a one to one correspondence |
1943
|
|
|
|
|
|
|
of days regardless of years. However, the variations follow a 400 year |
1944
|
|
|
|
|
|
|
cycle. |
1945
|
|
|
|
|
|
|
|
1946
|
|
|
|
|
|
|
I<The "I" in the above is Tom Braun -- TRW> |
1947
|
|
|
|
|
|
|
|
1948
|
|
|
|
|
|
|
=head1 AUTHOR |
1949
|
|
|
|
|
|
|
|
1950
|
|
|
|
|
|
|
Tom Braun <tbraun@pobox.com> |
1951
|
|
|
|
|
|
|
|
1952
|
|
|
|
|
|
|
Thomas R. Wyant, III F<wyant at cpan dot org> |
1953
|
|
|
|
|
|
|
|
1954
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
1955
|
|
|
|
|
|
|
|
1956
|
|
|
|
|
|
|
Copyright (c) 2003 Tom Braun. All rights reserved. |
1957
|
|
|
|
|
|
|
|
1958
|
|
|
|
|
|
|
Copyright (C) 2017-2021 Thomas R. Wyant, III |
1959
|
|
|
|
|
|
|
|
1960
|
|
|
|
|
|
|
The calendar implemented on this module was created by J.R.R. Tolkien, |
1961
|
|
|
|
|
|
|
and the copyright is still held by his estate. The license and |
1962
|
|
|
|
|
|
|
copyright given herein applies only to this code and not to the |
1963
|
|
|
|
|
|
|
calendar itself. |
1964
|
|
|
|
|
|
|
|
1965
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
1966
|
|
|
|
|
|
|
under the same terms as Perl itself. For more details, see the full text |
1967
|
|
|
|
|
|
|
of the licenses in the LICENSES directory included with this module. |
1968
|
|
|
|
|
|
|
|
1969
|
|
|
|
|
|
|
This program is distributed in the hope that it will be useful, but |
1970
|
|
|
|
|
|
|
without any warranty; without even the implied warranty of |
1971
|
|
|
|
|
|
|
merchantability or fitness for a particular purpose. |
1972
|
|
|
|
|
|
|
|
1973
|
|
|
|
|
|
|
=head1 SUPPORT |
1974
|
|
|
|
|
|
|
|
1975
|
|
|
|
|
|
|
Support on this module may be obtained by emailing me. However, I am |
1976
|
|
|
|
|
|
|
not a developer on the other classes in the DateTime project. For |
1977
|
|
|
|
|
|
|
support on them, please see the support options in the DateTime |
1978
|
|
|
|
|
|
|
documentation. |
1979
|
|
|
|
|
|
|
|
1980
|
|
|
|
|
|
|
Support is by the author. Please file bug reports at |
1981
|
|
|
|
|
|
|
L<https://rt.cpan.org/Public/Dist/Display.html?Name=DateTime-Fiction-JRRTolkien-Shire>, |
1982
|
|
|
|
|
|
|
L<https://github.com/trwyant/perl-DateTime-Fiction-JRRTolkien-Shire/issues>, or in |
1983
|
|
|
|
|
|
|
electronic mail to the author. |
1984
|
|
|
|
|
|
|
|
1985
|
|
|
|
|
|
|
=head1 BIBLIOGRAPHY |
1986
|
|
|
|
|
|
|
|
1987
|
|
|
|
|
|
|
Tolkien, J. R. R. I<Return of the King>. New York: Houghton Mifflin |
1988
|
|
|
|
|
|
|
Press, 1955. |
1989
|
|
|
|
|
|
|
|
1990
|
|
|
|
|
|
|
L<http://www.glyphweb.com/arda/f/fourthage.html> |
1991
|
|
|
|
|
|
|
|
1992
|
|
|
|
|
|
|
=head1 SEE ALSO |
1993
|
|
|
|
|
|
|
|
1994
|
|
|
|
|
|
|
The DateTime project documentation (perldoc DateTime, datetime@perl.org |
1995
|
|
|
|
|
|
|
mailing list, or L<http://datetime.perl.org/>). |
1996
|
|
|
|
|
|
|
|
1997
|
|
|
|
|
|
|
=cut |
1998
|
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
1; |
2000
|
|
|
|
|
|
|
|
2001
|
|
|
|
|
|
|
# ex: set textwidth=72 : |