Date-Tolkien-Shire-Data
view release on metacpan or search on metacpan
lib/Date/Tolkien/Shire/Data.pm view on Meta::CPAN
defined $cond[1]
and not $date->__fmt_shire_month()
and $inx = 1;
defined $cond[2]
and not __day_of_week( $date->__fmt_shire_month(), $date->__fmt_shire_day() )
and $inx = 2;
return __format( $date, $cond[$inx] );
}
{
# NOTE - I _was_ using assignment to $_[2] followed by a goto to
# dispatch _fmt_number__2() and _fmt_number_02(). But this produced
# test failures under 5.8.5, which I was able to reproduce, though
# not under -d:ptkdb, which suggests it was an optimizer problem.
# Only _fmt_number__2() resulted in the failures, but I recoded
# both, plus the couple dispatches directly to _fmt_number() since
# the previous dispatch scheme for all three involved fiddling with
# the contents of @_. There is still a goto inside _fmt_number__2(),
# but since I no longer modify @_, I have let that stand.
my %spec = (
A => sub { $_[0]->__fmt_shire_traditional() ?
__trad_weekday_name( $_[0]->__fmt_shire_day_of_week() ) :
__weekday_name( $_[0]->__fmt_shire_day_of_week() );
},
a => sub { $_[0]->__fmt_shire_traditional() ?
__trad_weekday_abbr( $_[0]->__fmt_shire_day_of_week() ) :
__weekday_abbr( $_[0]->__fmt_shire_day_of_week() );
},
B => sub { __month_name( $_[0]->__fmt_shire_month() ) },
b => sub { __month_abbr( $_[0]->__fmt_shire_month() ) },
C => sub {
return _fmt_number_02( @_[ 0, 1 ],
int( $_[0]->__fmt_shire_year() / 100 ) );
},
c => sub { __format( $_[0], '%{{%a %x||||%x}} %X' ) },
D => sub { __format( $_[0], '%{{%m/%d||%Ee}}/%y' ) },
d => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_day() );
},
Ea => sub { $_[0]->__fmt_shire_traditional() ?
__trad_weekday_narrow( $_[0]->__fmt_shire_day_of_week() ) :
__weekday_narrow( $_[0]->__fmt_shire_day_of_week() );
},
Ed => \&_fmt_on_date,
EE => sub { __holiday_name( $_[0]->__fmt_shire_month() ? 0 :
$_[0]->__fmt_shire_day() ) },
Ee => sub { __holiday_abbr( $_[0]->__fmt_shire_month() ? 0 :
$_[0]->__fmt_shire_day() ) },
En => sub { $_[1]{prefix_new_line_unless_empty}++; '' },
Eo => sub { __holiday_narrow( $_[0]->__fmt_shire_month() ? 0 :
$_[0]->__fmt_shire_day() ) },
Ex => sub { __format( $_[0],
'%{{%A %-e %B %Y||%A %EE %Y||%EE %Y}}' ) },
e => sub {
return _fmt_number__2( @_[ 0, 1 ],
$_[0]->__fmt_shire_day() );
},
F => sub { __format( $_[0], '%Y-%{{%m-%d||%Ee}}' ) },
# G Same as Y by definition of Shire calendar
H => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_hour() );
},
# h Same as b by definition of strftime()
I => sub {
return _fmt_number_02( @_[ 0, 1 ],
( $_[0]->__fmt_shire_hour() || 0 ) % 12 || 12,
);
},
j => sub {
defined $_[1]{wid}
or $_[1]{wid} = 3;
return _fmt_number( @_[ 0, 1 ],
__date_to_day_of_year(
$_[0]->__fmt_shire_year(),
$_[0]->__fmt_shire_month(),
$_[0]->__fmt_shire_day(),
),
);
},
k => sub {
return _fmt_number__2( @_[ 0, 1 ],
$_[0]->__fmt_shire_hour() );
},
l => sub {
return _fmt_number__2( @_[ 0, 1 ],
( $_[0]->__fmt_shire_hour() || 0 ) % 12 || 12 );
},
M => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_minute() );
},
m => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_month() );
},
N => sub {
defined $_[1]{wid}
or $_[1]{wid} = 9;
return _fmt_number( @_[ 0, 1 ],
$_[0]->__fmt_shire_nanosecond(),
);
},
n => sub { "\n" },
P => sub { lc __am_or_pm( $_[0]->__fmt_shire_hour() ) },
p => sub { uc __am_or_pm( $_[0]->__fmt_shire_hour() ) },
R => sub { __format( $_[0], '%H:%M' ) },
r => sub { __format( $_[0], '%I:%M:%S %p' ) },
S => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_second() );
},
s => sub { $_[0]->__fmt_shire_epoch() },
T => sub { __format( $_[0], '%H:%M:%S' ) },
t => sub { "\t" },
U => sub {
return _fmt_number_02( @_[ 0, 1 ],
__week_of_year(
$_[0]->__fmt_shire_month(),
$_[0]->__fmt_shire_day(),
),
);
},
u => sub { $_[0]->__fmt_shire_day_of_week() },
# V Same as U by definition of Shire calendar
v => sub { __format( $_[0], '%{{%e-%b-%Y||%Ee-%Y}}' ) },
# W Same as U by definition of Shire calendar
# X Same as r, I think
x => sub { __format( $_[0], '%{{%e %b %Y||%Ee %Y}}' ) },
Y => sub { $_[0]->__fmt_shire_year() },
y => sub {
return _fmt_number_02( @_[ 0, 1 ],
$_[0]->__fmt_shire_year() % 100 );
},
Z => sub { $_[0]->__fmt_shire_zone_name() },
z => sub { _fmt_offset( $_[0]->__fmt_shire_zone_offset() ) },
'%' => sub { '%' },
);
$spec{G} = $spec{Y}; # By definition of Shire calendar.
$spec{h} = $spec{b}; # By definition of strftime().
$spec{V} = $spec{U}; # By definition of Shire calendar.
$spec{W} = $spec{U}; # By definition of Shire calendar.
$spec{w} = $spec{u}; # Because the strftime() definition of
# %w makes no sense to me in terms of
# the Shire calendar.
$spec{X} = $spec{r}; # I think this is right ...
$spec{'{'} = $spec{'}'} = $spec{'|'} = $spec{'%'};
my %modifier_map = (
0 => sub { $_[0]{pad} = '0' },
'-' => sub { $_[0]{pad} = '' },
_ => sub { $_[0]{pad} = ' ' },
'^' => sub { $_[0]{uc} = 1 },
'#' => sub { $_[0]{change_case} = 1 },
);
my %case_change = map { $_ => sub { uc $_[0] } }
qw{ A a B b EE Ee h };
$case_change{p} = $case_change{Z} = sub { lc $_[0] };
# Note that if I should choose to implement field widths, the width,
# if specified, causes padding with spaces if '-' (no padding) was
# specified.
sub _fmt_conv {
my ( $date, $conv, $mod, $wid, $ctx ) = @_;
defined $mod
or $mod = '';
$wid
and $ctx->{wid} = $wid;
my $code;
foreach my $char ( split qr{}, $mod ) {
$code = $modifier_map{$char}
and $code->( $ctx );
}
if ( $wid ) {
$ctx->{wid} = $wid;
defined $ctx->{pad}
and '' eq $ctx->{pad}
and $ctx->{pad} = ' ';
}
my $rslt;
if ( $code = $spec{$conv} ) {
$rslt = $code->( $date, $ctx );
} elsif ( 1 < length $conv and $code = $spec{ substr $conv, 1 } ) {
$rslt = $code->( $date, $ctx );
} else {
$rslt = "%$mod$wid$conv";
}
defined $rslt
or $rslt = '';
if ( delete $ctx->{change_case} and $code = $case_change{$conv} ) {
delete $ctx->{uc};
$rslt = $code->( $rslt );
}
delete $ctx->{uc}
and $rslt = uc $rslt;
my $need;
$ctx->{wid}
and '' ne $ctx->{pad}
and ( $need = $ctx->{wid} - length $rslt ) > 0
and $rslt = ( $ctx->{pad} x $need ) . $rslt;
delete @{ $ctx }{ qw{ pad wid } };
return $rslt;
}
lib/Date/Tolkien/Shire/Data.pm view on Meta::CPAN
}
return @data;
}
# Create methods for the hash wrapper
{
my %calc = (
day_of_week => sub {
return __day_of_week( $_[0]->__fmt_shire_month(), $_[0]->__fmt_shire_day() );
},
## quarter => sub {
## return __quarter( $_[0]->__fmt_shire_month(), $_[0]->__fmt_shire_day() );
## },
);
foreach my $field ( qw{
year month day
hour minute second nanosecond epoch
zone_offset zone_name
accented traditional
}, keys %calc ) {
my $fqn = join '::', __PACKAGE__, 'Date', "__fmt_shire_$field";
if ( my $code = $calc{$field} ) {
no strict qw{ refs };
*$fqn = sub {
defined $_[0]->{$field}
or $_[0]->{$field} = $code->( $_[0] );
return $_[0]->{$field};
};
} else {
no strict qw{ refs };
*$fqn = sub { $_[0]->{$field} };
}
}
}
{
my $validate;
BEGIN {
$validate = _make_validator( qw{ UInt|Undef Array } );
}
sub _lookup {
my ( $inx, $tbl ) = $validate->( @_ );
defined $inx
and return $tbl->[ $inx ];
__PACKAGE__ eq caller
or Carp::croak( 'Index not defined' );
return $tbl;
}
}
1;
__END__
=head1 NAME
Date::Tolkien::Shire::Data - Data functionality for Shire calendars.
=head1 SYNOPSIS
use Date::Tolkien::Shire::Data;
say __on_date( 1, 2 ) // "Nothing happened\n";
=head1 DESCRIPTION
This Perl module carries common functionality for implementations of the
Shire calendar as described in Appendix D of J. R. R. Tolkien's novel
"Lord Of The Rings". What it really contains is anything that was common
to L<Date::Tolkien::Shire|Date::Tolkien::Shire> and
L<DateTime::Fiction::JRRTolkien::Shire|DateTime::Fiction::JRRTolkien::Shire>
and I felt like factoring out. You probably do not want to use this
module directly, at least not without looking into the other two.
The Shire calendar has 12 months of 30 days each, plus 5 holidays (6 in
a leap year) that are not part of any month. Two of these holidays
(Midyear's day and the Overlithe) are also part of no week.
In all of the following, years are counted from the founding of the
Shire. Months are numbered C<1-12>, and days in months from C<1-30>.
Holidays are specified by giving a month of C<0> and the holiday number,
as follows:
=over
=item 1 - 2 Yule
=item 2 - 1 Lithe
=item 3 - Midyear's day
=item 4 - Overlithe (which occurs in leap years only)
=item 5 - 2 Lithe (so numbered even in non-leap years)
=item 6 - 1 Yule
=back
This module is subroutine-based. Nothing is exported by default, but
everything public can be exported by name. In addition the following
export tags exist:
=over
=item C<:all> - export everything;
=item C<:consts> - export all manifest constants;
=item C<:subs> - export all subroutines.
=back
=head1 SUBROUTINES
This class supports the following public subroutines. Anything
documented below is public unless its documentation explicitly states
otherwise. The names begin with double underscores because it is
anticipated that, although they are public as far as this package is
concerned, they will be package-private for the purposes of any code
that uses this package.
All of the following are exportable to your name space, but none are
exported by default. They can all be exported using export tag C<:subs>.
=head2 __am_or_pm
This subroutine takes as input an hour of the day in the range 0 to 23
and returns C<'AM'> if the hour is less than 12, or C<'PM'> otherwise.
=head2 __date_to_day_of_year
say __date_to_day_of_year( 1420, 3, 25 );
This subroutine takes as input a year, month, and day and returns the
lib/Date/Tolkien/Shire/Data.pm view on Meta::CPAN
The equivalent of C<'%m/%d/%y'>, or C<'%Ee/%y'> on holidays. This format
is discouraged, because it may not be clear whether it is month/day/year
(as the United States does it) or day/month/year (as Europe does it).
=item %d
The day of the month as a decimal number, zero-filled (range C<01> to
C<30>). On holidays it is the holiday number, zero-filled (range C<01>
to C<06>).
=item %Ea
The narrow (2-character) weekday name, or C<''> for holidays that are
part of no week.
=item %Ed
The L<__on_date()|/__on_date> text for the given date.
You can get a leading C<"\n"> if there was an actual event using
C<'%En%Ed'>. So to mimic L<Date::Tolkien::Shire|Date::Tolkien::Shire>
L<on_date()|Date::Tolkien::Shire/on_date>, use C<'%Ex%n%En%Ed'>.
=item %EE
The full holiday name, or C<''> for non-holidays.
=item %Ee
The abbreviated holiday name, or C<''> for non-holidays.
=item %En
Inserts nothing, but causes the next C<%Ed> (and B<only> the next one)
to have a C<"\n"> prefixed if there was an actual event on the date.
=item %Eo
The narrow (2-character) holiday name, or C<''> for non-holidays.
=item %Ex
Like C<'%c'>, but without the time of day, and with full names rather
than abbreviations.
=item %e
The day of the month as a decimal number, space-filled (range C<' 1'> to
C<'30'>). On holidays it is the holiday number, space-filled (range
C<' 1'> to C<' 6'>).
=item %F
For normal dates this is equivalent to C<'%Y-%m-%d'> (i.e. the ISO 8601
date format). For holidays it is equivalent to C<'%Y-%Er'>, which is
something ISO had nothing to do with.
=item %G
The ISO 8601 year number. Given how the Shire calendar is defined, the
ISO year number is the same as the calendar year (i.e. C<'%Y'>).
=item %H
The hour, zero-filled, in the range C<'00'> to C<'23'>.
=item %h
Equivalent to C<'%b'>.
=item %I
The hour, zero-filled, in the range C<'01'> to C<'12'>.
=item %j
The day of the year, zero-filled, in the range C<'001'> to C<'366'>.
=item %k
The hour, blank-filed, in the range C<' 0'> to C<'23'>.
=item %l
The hour, blank-filled, in the range C<' 1'> to C<'12'>.
=item %M
The minute, zero-filled, in the range C<'00'> to C<'59'>.
=item %m
The month number, zero filled, in the range C<'01'> to C<'12'>. On
holidays it is C<'00'>.
=item %N
The fractional seconds. A decimal digit may appear between the percent
sign and the C<'N'> to specify the precision: C<'3'> gives milliseconds,
C<'6'> microseconds, and C<'9'> nanoseconds. The default is C<'9'>.
=item %n
A newline character.
=item %P
The meridian indicator, C<'am'> or C<'pm'>.
=item %p
The meridian indicator, C<'AM'> or C<'PM'>.
=item %R
The time in hours and minutes, on a 24-hour clock. Equivalent to
C<'%H:%M'>.
=item %r
The time in hours, minutes and seconds on a 12-hour clock. Equivalent
lib/Date/Tolkien/Shire/Data.pm view on Meta::CPAN
returned. Otherwise C<undef> is returned.
=head2 __month_name_to_number
say __month_name_to_number( 'forelithe' );
Given a month name, this subroutine normalizes it by converting it to
lower case and removing spaces and punctuation, and then returns the
number of the month. Unique abbreviations of names or short names
(a.k,a. abbreviations) are allowed. Arguments consisting entirely of
digits are returned unmodified. Anything unrecognized causes C<0> to be
returned.
=head2 __month_abbr
say __month_abbr( 3 );
Given a month number C<(1-12)>, this subroutine returns that month's
three-letter abbreviation. If the month number is C<0> (i.e. a holiday),
the empty string is returned. Otherwise C<undef> is returned.
=head2 __on_date
say __on_date( $month, $day ) // '';
say __on_date( $holiday ) // '';
Given month and day numbers (or a holiday number), returns text
representing the events during and around the War of the Ring that
occurred on that date. If nothing happened or any argument is out of
range, C<undef> is returned.
The actual text returned is from Appendix B of "Lord Of The Rings", and
is copyright J. R. R. Tolkien, renewed by Christopher R. Tolkien et al.
Specifically, I use the Houghton Mifflin trade paperback. I find no date
of publication, but believe it to be the early 2000s because the cover
illustrations appear to be movie tie-ins.
=head2 __on_date_accented
binmode STDOUT, ':encoding(utf-8)';
say __on_date_accented( $month, $day ) // '';
say __on_date( $holiday ) // '';
This wrapper for L<__on_date()|/__on_date> accents those names and
words that are accented in the text of the Lord Of The Rings. How these
display depends on how your Perl is configured. Note that the example
above assumes Perl 5.10 (for C<say()> and C<//>). Even without those,
the two-argument C<binmode()> requires 5.8. Your mileage may vary.
Note that the first call incurs the overhead of accenting all events.
=head2 __quarter
say __quarter( $month, $day );
Given month and day numbers, returns the relevant quarter number. If the
date specified is Midyear's day or the Overlithe ("month" C<0>, days
C<3-4>), the result is C<0>; otherwise it is a number in the range
C<1-4>.
There is nothing I know of about hobbits using calendar quarters in
anything Tolkien wrote. But if they did use them I suspect they would be
rationalized this way.
=head2 __quarter_name
Given the quarter number, return the name of the quarter. If the quarter
number is C<0> (i.e. Midyear's day or Overlithe), C<''> is returned.
=head2 __quarter_abbr
Given the quarter number, return the abbreviated name of the quarter. If
the quarter number is C<0> (i.e. Midyear's day or Overlithe), C<''> is
returned.
=head2 __rata_die_to_year_day
my ( $year, $day ) = __rata_die_to_year_day( $rata_die );
Given a Rata Die day, returns the year and day of the year corresponding
to that Rata Die day.
The algorithm used was inspired by Howard Hinnant's "C<chrono>-Compatible
Low-Level Date Algorithms" at
L<http://howardhinnant.github.io/date_algorithms.html>, and in
particular his C<civil_from_days()> algorithm at
L<http://howardhinnant.github.io/date_algorithms.html#civil_from_days>.
This subroutine assumes no particular calendar, though it does assume
the Gregorian year-length rules, which have also been adopted for the
Shire calendar. If you feed it an honest-to-God Rata Die day (i.e. days
since December 31 of proleptic Gregorian year 0) you get back the
Gregorian year and the day of that year (C<1-366>). If you feed it a
so-called Shire Rata Die (i.e. days since 1 Yule of Shire year 0) you
get back the Shire year and the day of that year.
=head2 __trad_weekday_name
say 'Day 1 is ', __trad_weekday_name( 1 );
This subroutine computes the traditional (i.e. old-style) name of a
weekday given its number (1-7). If the weekday number is C<0> (i.e.
Midyear's day or the Overlithe) the empty string is returned. Otherwise,
C<undef> is returned.
=head2 __trad_weekday_abbr
say 'Day 1 is ', __trad_weekday_abbr( 1 );
This subroutine computes the three-letter abbreviation of a traditional
(i.e. old-style) weekday given its number (1-7). If the weekday number
is C<0> (i.e. Midyear's day or the Overlithe) the empty string is
returned. Otherwise, C<undef> is returned.
=head2 __trad_weekday_narrow
say 'Day 1 is ', __trad_weekday_narrow( 1 );
This subroutine computes the two-letter abbreviation of a traditional
(i.e. old-style) weekday given its number (1-7). If the weekday number
is C<0> (i.e. Midyear's day or the Overlithe) the empty string is
returned. Otherwise, C<undef> is returned.
=head2 __valid_date_class
eval {
__valid_date_class( $class );
print "$class OK\n";
1;
} or print $@;
This subroutine takes as its argument either an object or a class name.
If a class name, it is loaded if needed and possible. Then the class is
checked to see if it has all the methods required of a date object
passed to L<__format()|/__format>. If any missing methods are found an
exception is thrown naming the missing methods; otherwise it returns its
argument.
If you intend to use a class that autoloads requisite methods, that
class will need to properly override C<< UNIVERSAL->can() >>, or provide
forward references to autoloaded methods.
This subroutine is used internally to validate the date argument to
L<__format()|/__format>. It is exposed for troubleshooting purposes.
See also F<tools/valid-date-class>.
=head2 __weekday_name
say 'Day 1 is ', __weekday_name( 1 );
This subroutine computes the name of a weekday given its number (1-7).
If the weekday number is C<0> (i.e. Midyear's day or the Overlithe) the
empty string is returned. Otherwise, C<undef> is returned.
=head2 __weekday_abbr
say 'Day 1 is ', __weekday_abbr( 1 );
This subroutine computes the three-letter abbreviation of a weekday
given its number (1-7). If the weekday number is C<0> (i.e. Midyear's
day or the Overlithe) the empty string is returned. Otherwise, C<undef>
is returned.
=head2 __weekday_narrow
say 'Day 1 is ', __weekday_narrow( 1 );
This subroutine computes the two-letter abbreviation of a weekday
given its number (1-7). If the weekday number is C<0> (i.e. Midyear's
day or the Overlithe) the empty string is returned. Otherwise, C<undef>
is returned.
=head2 __week_of_year
say '25 Rethe is in week ', __week_of_year( 3, 25 );
This subroutine computes the week number of the given month and day.
Weeks start on Sterday, and the first week of the year is week 1. If the
date is part of no week (i.e. Midyear's day or the Overlithe), C<0> is
returned.
=head2 __year_day_to_rata_die
my $rata_die = __year_day_to_rata_die(
$year, $day_of_year );
Given the year and day of the year, this subroutine returns the Rata Die
day of the given year and day. The day of the year defaults to C<1>.
This subroutine assumes no particular calendar, though it does assume
the Gregorian year-length rules, which have also been adopted for the
Shire calendar. If you feed it a Gregorian year, you get an
honest-to-God Rata Die, as in days since December 31 of proleptic
Gregorian year 0. If you feed it a Shire year, you get a so-called Shire
Rata Die, as in the days since 1 Yule of Shire year 0.
=head1 MANIFEST CONSTANTS
The following manifest constants are exportable to your name space. None
is exported by default. They can all be exported using export tag
C<:consts>.
=head2 DAY_OF_YEAR_MIDYEARS_DAY
This manifest constant represents the day number of C<Midyear's day> in
the year, i.e. C<183>.
=head2 DAY_OF_YEAR_OVERLITHE
This manifest constant represents the day number of C<Overlithe> in the
year, i.e. C<184>. Be aware that day C<184> is C<Overlithe> only in a
leap year; otherwise day C<184> is C<2 Lithe>.
=head2 GREGORIAN_RATA_DIE_TO_SHIRE
This manifest constant represents the number of days to add to a real
Rata Die value (days since December 31 of proleptic Gregorian year 0) to
get a so-called Shire Rata Die (days since 1 Yule of Shire year 0.)
The value was determined by the following computation.
my $dts = DateTime::Fiction::JRRTolkien::Shire->new(
year => 1,
holiday => 1,
);
my $gdt = DateTime->new(
year => 1,
month => 1,
day => 1,
);
my $rd_to_shire = ( $gdt->utc_rd_values() )[0] -
( $dts->utc_rd_values() )[0];
using
L<DateTime::Fiction::JRRTolkien::Shire|DateTime::Fiction::JRRTolkien::Shire>
version 0.21. This is after I adopted that module but before I started
messing with the computational internals.
=head3 HOLIDAY_2_YULE
This manifest constant represents the holiday number of <2 Yule>, i.e.
C<1>.
=head3 HOLIDAY_1_LITHE
This manifest constant represents the holiday number of <1 Lithe>, i.e.
C<2>.
=head3 HOLIDAY_MIDYEARS_DAY
This manifest constant represents the holiday number of <Midyear's day>,
i.e. C<3>.
( run in 0.644 second using v1.01-cache-2.11-cpan-0bb4e1dffa6 )