--- /dev/null
+package HTML::CalendarMonth::Locale;
+{
+ $HTML::CalendarMonth::Locale::VERSION = '2.00';
+}
+
+# Front end class around DateTime::Locale. In addition to providing
+# access to the DT::Locale class and locale-specific instance, this
+# class prepares some other hashes and lookups utilized by
+# HTML::CalendarMonth.
+
+use strict;
+use warnings;
+use Carp;
+
+use DateTime::Locale 0.45;
+
+sub _locale_version { $DateTime::Locale::VERSION }
+
+my($CODE_METHOD, $CODES_METHOD);
+if (_locale_version() > 0.92) {
+ $CODE_METHOD = "code";
+ $CODES_METHOD = "codes";
+}
+else {
+ $CODE_METHOD = "id";
+ $CODES_METHOD = "ids";
+}
+
+my %Register;
+
+sub new {
+ my $class = shift;
+ my $self = {};
+ bless $self, $class;
+ my %parms = @_;
+ # id is for backwards compatibility
+ my $code = $parms{code} || $parms{id}
+ or croak "Locale code required (eg 'en-US')\n";
+ $self->{full_days} = defined $parms{full_days} ? $parms{full_days} : 0;
+ $self->{full_months} = defined $parms{full_months} ? $parms{full_months} : 1;
+ # returned code might be different from given code
+ unless ($Register{$code}) {
+ my $dtl = $self->locale->load($code)
+ or croak "Problem loading locale '$code'";
+ $Register{$code} = $Register{$dtl->$CODE_METHOD} = { loc => $dtl };
+ }
+ $self->{code} = $Register{$code}{loc}->$CODE_METHOD;
+ $self;
+}
+
+sub locale { 'DateTime::Locale' }
+
+sub loc { $Register{shift->code}{loc} }
+
+sub locales { shift->locale->$CODES_METHOD }
+
+sub code { shift->{code} }
+*id = *code;
+
+sub full_days { shift->{full_days} }
+sub full_months { shift->{full_months} }
+
+sub first_day_of_week { shift->loc->first_day_of_week % 7 }
+
+sub days {
+ my $self = shift;
+ my $code = $self->code;
+ unless ($Register{$code}{days}) {
+ my $method = $self->full_days ? 'day_stand_alone_wide'
+ : 'day_stand_alone_abbreviated';
+ # adjust to H::CM standard expectation, 1st day Sun
+ # Sunday is first, regardless of what the calendar considers to be
+ # the first day of the week
+ my @days = @{$self->loc->$method};
+ unshift(@days, pop @days);
+ $Register{$code}{days} = \@days;
+ }
+ wantarray ? @{$Register{$code}{days}} : $Register{$code}{days};
+}
+
+sub narrow_days {
+ my $self = shift;
+ my $code = $self->code;
+ unless ($Register{$code}{narrow_days}) {
+ # Sunday is first, regardless of what the calendar considers to be
+ # the first day of the week
+ my @days = @{ $self->loc->day_stand_alone_narrow };
+ unshift(@days, pop @days);
+ $Register{$code}{narrow_days} = \@days;
+ }
+ wantarray ? @{$Register{$code}{narrow_days}}
+ : $Register{$code}{narrow_days};
+}
+
+sub months {
+ my $self = shift;
+ my $code = $self->code;
+ unless ($Register{$code}{months}) {
+ my $method = $self->full_months > 0 ? 'month_stand_alone_wide'
+ : 'month_stand_alone_abbreviated';
+ $Register{$code}{months} = [@{$self->loc->$method}];
+ }
+ wantarray ? @{$Register{$code}{months}} : $Register{$code}{months};
+}
+
+sub narrow_months {
+ my $self = shift;
+ my $code = $self->code;
+ $Register{$code}{narrow_months}
+ ||= [@{$self->loc->month_stand_alone_narrow}];
+ wantarray ? @{$Register{$code}{narrow_months}}
+ : $Register{$code}{narrow_months};
+}
+
+sub days_minmatch {
+ my $self = shift;
+ $Register{$self->code}{days_mm}
+ ||= $self->lc_minmatch_hash($self->days);
+}
+*minmatch = \&days_minmatch;
+
+sub _days_minmatch_pattern {
+ my $dmm = shift->days_minmatch;
+ join('|', sort keys %$dmm);
+}
+*minmatch_pattern = \&_days_minmatch_pattern;
+
+sub months_minmatch {
+ my $self = shift;
+ $Register{$self->code}{months_mm}
+ ||= $self->lc_minmatch_hash($self->months);
+}
+
+sub _months_minmatch_pattern {
+ my $mmm = shift->months_minmatch;
+ join('|', sort keys %$mmm);
+}
+
+sub daynums {
+ my $self = shift;
+ my $code = $self->code;
+ unless ($Register{$code}{daynum}) {
+ my %daynum;
+ my $days = $self->days;
+ $daynum{$days->[$_]} = $_ foreach 0 .. $#$days;
+ $Register{$code}{daynum} = \%daynum;
+ }
+ wantarray ? %{$Register{$code}{daynum}}
+ : $Register{$code}{daynum};
+}
+
+sub _daymatch {
+ my($self, $day) = @_;
+ return unless defined $day;
+ if ($day =~ /^\d+$/) {
+ $day %= 7;
+ return($day, $self->days->[$day]);
+ }
+ my $p = $self->_days_minmatch_pattern;
+ if ($day =~ /^($p)/i) {
+ $day = $self->days_minmatch->{lc $1};
+ return($self->daynums->{$day}, $day);
+ }
+ return ();
+}
+
+sub daynum { (shift->_daymatch(@_))[0] }
+sub dayname { (shift->_daymatch(@_))[1] }
+
+sub monthnums {
+ my $self = shift;
+ my $code = $self->code;
+ unless ($Register{$code}{monthnum}) {
+ my %monthnum;
+ my $months = $self->months;
+ $monthnum{$months->[$_]} = $_ foreach 0 .. $#$months;
+ $Register{$code}{monthnum} = \%monthnum;
+ }
+ wantarray ? %{$Register{$code}{monthnum}}
+ : $Register{$code}{monthnum};
+}
+
+sub _monthmatch {
+ my($self, $mon) = @_;
+ return unless defined $mon;
+ if ($mon =~ /^\d+$/) {
+ $mon %= 12;
+ return($mon, $self->months->[$mon]);
+ }
+ my $p = $self->_months_minmatch_pattern;
+ if ($mon =~ /^($p)/i) {
+ $mon = $self->months_minmatch->{lc $1};
+ return($self->monthnums->{$mon}, $mon);
+ }
+ return ();
+}
+
+sub monthnum { (shift->_monthmatch(@_))[0] }
+sub monthname { (shift->_monthmatch(@_))[1] }
+
+###
+
+sub locale_map {
+ my $self = shift;
+ my %map;
+ foreach my $code ($self->locales) {
+ $map{$code} = $self->locale->load($code)->name;
+ }
+ wantarray ? %map : \%map;
+}
+
+###
+
+sub lc_minmatch_hash {
+ # given a list, provide a reverse lookup of case-insensitive minimal
+ # values for each label in the list
+ my $whatever = shift;
+ my @orig_labels = @_;
+ my @labels = map { lc $_ } @orig_labels;
+ my $cc = 1;
+ my %minmatch;
+ while (@labels) {
+ my %scratch;
+ foreach my $i (0 .. $#labels) {
+ my $str = $labels[$i];
+ my $chrs = substr($str, 0, $cc);
+ $scratch{$chrs} ||= [];
+ push(@{$scratch{$chrs}}, $i);
+ }
+ my @keep_i;
+ foreach (keys %scratch) {
+ if (@{$scratch{$_}} == 1) {
+ $minmatch{$_} = $orig_labels[$scratch{$_}[0]];
+ }
+ else {
+ push(@keep_i, @{$scratch{$_}});
+ }
+ }
+ @labels = @labels[@keep_i];
+ @orig_labels = @orig_labels[@keep_i];
+ ++$cc;
+ }
+ \%minmatch;
+}
+
+sub minmatch_hash {
+ # given a list, provide a reverse lookup of minimal values for each
+ # label in the list
+ my $whatever = shift;
+ my @labels = @_;
+ my $cc = 1;
+ my %minmatch;
+ while (@labels) {
+ my %scratch;
+ foreach my $i (0 .. $#labels) {
+ my $str = $labels[$i];
+ my $chrs = substr($str, 0, $cc);
+ $scratch{$chrs} ||= [];
+ push(@{$scratch{$chrs}}, $i);
+ }
+ my @keep_i;
+ foreach (keys %scratch) {
+ if (@{$scratch{$_}} == 1) {
+ $minmatch{$_} = $labels[$scratch{$_}[0]];
+ }
+ else {
+ push(@keep_i, @{$scratch{$_}});
+ }
+ }
+ @labels = @labels[@keep_i];
+ ++$cc;
+ }
+ \%minmatch;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
+
+=head1 SYNOPSIS
+
+ use HTML::CalendarMonth::Locale;
+
+ my $loc = HTML::CalendarMonth::Locale->new( code => 'en-US' );
+
+ # list of days of the week for locale
+ my @days = $loc->days;
+
+ # list of months of the year for locale
+ my @months = $loc->months;
+
+ # the name of the current locale, as supplied the code parameter to
+ # new()
+ my $locale_name = $loc->code;
+
+ # the actual DateTime::Locale object
+ my $loc = $loc->loc;
+
+ 1;
+
+=head1 DESCRIPTION
+
+HTML::CalendarMonth utilizes the powerful locale capabilities of
+DateTime::Locale for rendering its calendars. The default locale is
+'en-US' but many others are available. To see this list, invoke the
+class method HTML::CalendarMonth::Locale->locales() which in turn
+invokes DateTime::Locale::codes().
+
+This module is mostly intended for internal usage within
+HTML::CalendarMonth, but some of its functionality may be of use for
+developers:
+
+=head1 METHODS
+
+=over
+
+=item new()
+
+Constructor. Takes the following parameters:
+
+=over
+
+=item code
+
+Locale code, e.g. 'en-US'.
+
+=item full_days
+
+Specifies whether full day names or their abbreviations are desired.
+Default 0, use abbreviated days.
+
+=item full_months
+
+Specifies whether full month names or their abbreviations are desired.
+Default 1, use full months.
+
+=back
+
+=item code()
+
+Returns the locale code used during object construction.
+
+=item locale()
+
+Accessor method for the DateTime::Locale class, which in turn offers
+several class methods of specific interest. See L<DateTime::Locale>.
+
+=item locale_map()
+
+Returns a hash of all available locales, mapping their code to their
+full name.
+
+=item loc()
+
+Accessor method for the DateTime::Locale instance as specified by C<code>.
+See L<DateTime::Locale>.
+
+=item locales()
+
+Lists all available locale codes. Equivalent to locale()->codes(), or
+DateTime::Locale->codes().
+
+=item days()
+
+Returns a list of days of the week, Sunday first. These are the actual
+unique day strings used for rendering calendars, so depending on which
+attributes were provided to C<new()>, this list will either be
+abbreviations or full names. The default uses abbreviated day names.
+Returns a list in list context or an array ref in scalar context.
+
+=item narrow_days()
+
+Returns a list of short day abbreviations, beginning with Sunday. The
+narrow abbreviations are not guaranteed to be unique (i.e. 'S' for both
+Sat and Sun).
+
+=item days_minmatch()
+
+Provides a hash reference containing minimal case-insensitive match
+strings for each day of the week, e.g., 'sa' for Saturday, 'm' for
+Monday, etc.
+
+=item months()
+
+Returns a list of months of the year, beginning with January. Depending
+on which attributes were provided to C<new()>, this list will either be
+full names or abbreviations. The default uses full names. Returns a list
+in list context or an array ref in scalar context.
+
+=item narrow_months()
+
+Returns a list of short month abbreviations, beginning with January. The
+narrow abbreviations are not guaranteed to be unique.
+
+=item months_minmatch()
+
+Provides a hash reference containing minimal case-insensitive match
+strings for each month of the year, e.g., 'n' for November, 'ja' for
+January, 'jul' for July, 'jun' for June, etc.
+
+=item daynums()
+
+Provides a hash reference containing day of week indices for each fully
+qualified day name as returned by days().
+
+=item daynum($day)
+
+Provides the day of week index for a particular day name.
+
+=item dayname($day)
+
+Provides the fully qualified day name for a given string or day index.
+
+=item monthnums()
+
+Provides a hash reference containing month of year indices for each
+fully qualified month name as returned by months().
+
+=item monthnum($month)
+
+Provides the month of year index for a particular month name.
+
+=item monthname($month)
+
+Provides the month name for a given string or month index.
+
+=item minmatch_hash(@list)
+
+This is the method used to generate the case-insensitive minimal match
+hash referenced above. Given an arbitrary list, a hash reference will
+be returned with minimal match strings as keys and the original strings
+as values.
+
+=item lc_minmatch_hash(@list)
+
+Same as minmatch_hash, except keys are forced to lower case.
+
+=item first_day_of_week()
+
+Returns a number from 0 to 6 representing the first day of the week for
+this locale, where 0 represents Sunday.
+
+=back
+
+=head1 AUTHOR
+
+Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
+
+=head1 COPYRIGHT
+
+Copyright (c) 2010-2015 Matthew P. Sisk. All rights reserved. All wrongs
+revenged. This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+HTML::CalendarMonth(3), DateTime::Locale(3)
+
+=for Pod::Coverage minmatch minmatch_pattern id
projects / deb_pkgs / libhtml-calendarmonth-perl.git / blobdiff