File Coverage

blib/lib/DateTime/Fiction/JRRTolkien/Shire.pm
Criterion Covered Total %
statement 340 377 90.1
branch 87 134 64.9
condition 38 60 63.3
subroutine 79 93 84.9
pod 44 59 74.5
total 588 723 81.3


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 :