1 package HTML::CalendarMonth::Locale;
3 $HTML::CalendarMonth::Locale::VERSION = '1.25';
6 # Front end class around DateTime::Locale. In addition to providing
7 # access to the DT::Locale class and locale-specific instance, this
8 # class prepares some other hashes and lookups utilized by
15 use DateTime::Locale 0.45;
24 my $id = $parms{id} or croak "Locale id required (eg 'en_US')\n";
26 $self->{full_days} = defined $parms{full_days} ? $parms{full_days} : 0;
27 $self->{full_months} = defined $parms{full_months} ? $parms{full_months} : 1;
28 unless ($Register{$id}) {
29 $Register{$id} = $self->locale->load($id)
30 or croak "Problem loading locale '$id'\n";
35 sub locale { 'DateTime::Locale' }
37 sub loc { $Register{shift->id} }
39 sub locales { shift->locale->ids }
41 sub id { shift->{id} }
42 sub full_days { shift->{full_days} }
43 sub full_months { shift->{full_months} }
45 sub first_day_of_week { shift->loc->first_day_of_week % 7 }
50 unless ($Register{$id}{days}) {
51 my $method = $self->full_days > 0 ? 'day_stand_alone_wide'
52 : 'day_stand_alone_abbreviated';
53 # adjust to H::CM standard expectation, 1st day Sun
54 # Sunday is first, regardless of what the calendar considers to be
55 # the first day of the week
56 my @days = @{$self->loc->$method};
57 unshift(@days, pop @days);
58 $Register{$id}{days} = \@days;
60 wantarray ? @{$Register{$id}{days}} : $Register{$id}{days};
66 unless ($Register{$id}{narrow_days}) {
67 # Sunday is first, regardless of what the calendar considers to be
68 # the first day of the week
69 my @days = @{ $self->loc->day_stand_alone_narrow };
70 unshift(@days, pop @days);
71 $Register{$id}{narrow_days} = \@days;
73 wantarray ? @{$Register{$id}{narrow_days}} : $Register{$id}{narrow_days};
79 unless ($Register{$id}{months}) {
80 my $method = $self->full_months > 0 ? 'month_stand_alone_wide'
81 : 'month_stand_alone_abbreviated';
82 $Register{$id}{months} = [@{$self->loc->$method}];
84 wantarray ? @{$Register{$id}{months}} : $Register{$id}{months};
90 $Register{$id}{narrow_months} ||= [$self->loc->month_stand_alone_narrow];
91 wantarray ? @{$Register{$id}{narrow_months}} : $Register{$id}{narrow_months};
96 $Register{$self->id}{days_mm}
97 ||= $self->lc_minmatch_hash($self->days);
99 *minmatch = \&days_minmatch;
101 sub _days_minmatch_pattern {
102 my $dmm = shift->days_minmatch;
103 join('|', sort keys %$dmm);
105 *minmatch_pattern = \&_days_minmatch_pattern;
108 sub months_minmatch {
110 $Register{$self->id}{months_mm}
111 ||= $self->lc_minmatch_hash($self->months);
114 sub _months_minmatch_pattern {
115 my $mmm = shift->months_minmatch;
116 join('|', sort keys %$mmm);
122 unless ($Register{$id}{daynum}) {
124 my $days = $self->days;
125 $daynum{$days->[$_]} = $_ foreach 0 .. $#$days;
126 $Register{$id}{daynum} = \%daynum;
128 $Register{$id}{daynum};
132 my($self, $day) = @_;
133 return unless defined $day;
134 if ($day =~ /^\d+$/) {
136 return($day, $self->days->[$day]);
138 my $p = $self->_days_minmatch_pattern;
139 if ($day =~ /^($p)/i) {
140 $day = $self->days_minmatch->{lc $1};
141 return($self->daynums->{$day}, $day);
146 sub daynum { (shift->_daymatch(@_))[0] }
147 sub dayname { (shift->_daymatch(@_))[1] }
152 unless ($Register{$id}{monthnum}) {
154 my $months = $self->months;
155 $monthnum{$months->[$_]} = $_ foreach 0 .. $#$months;
156 $Register{$id}{monthnum} = \%monthnum;
158 $Register{$id}{monthnum};
162 my($self, $mon) = @_;
163 return unless defined $mon;
164 if ($mon =~ /^\d+$/) {
166 return($mon, $self->months->[$mon]);
168 my $p = $self->_months_minmatch_pattern;
169 if ($mon =~ /^($p)/i) {
170 $mon = $self->months_minmatch->{lc $1};
171 return($self->monthnums->{$mon}, $mon);
176 sub monthnum { (shift->_monthmatch(@_))[0] }
177 sub monthname { (shift->_monthmatch(@_))[1] }
184 foreach my $id ($self->locales) {
185 $map{$id} = $self->locale->load($id)->name;
187 wantarray ? %map : \%map;
192 sub lc_minmatch_hash {
193 # given a list, provide a reverse lookup of case-insensitive minimal
194 # values for each label in the list
195 my $whatever = shift;
196 my @orig_labels = @_;
197 my @labels = map { lc $_ } @orig_labels;
202 foreach my $i (0 .. $#labels) {
203 my $str = $labels[$i];
204 my $chrs = substr($str, 0, $cc);
205 $scratch{$chrs} ||= [];
206 push(@{$scratch{$chrs}}, $i);
209 foreach (keys %scratch) {
210 if (@{$scratch{$_}} == 1) {
211 $minmatch{$_} = $orig_labels[$scratch{$_}[0]];
214 push(@keep_i, @{$scratch{$_}});
217 @labels = @labels[@keep_i];
218 @orig_labels = @orig_labels[@keep_i];
225 # given a list, provide a reverse lookup of minimal values for each
227 my $whatever = shift;
233 foreach my $i (0 .. $#labels) {
234 my $str = $labels[$i];
235 my $chrs = substr($str, 0, $cc);
236 $scratch{$chrs} ||= [];
237 push(@{$scratch{$chrs}}, $i);
240 foreach (keys %scratch) {
241 if (@{$scratch{$_}} == 1) {
242 $minmatch{$_} = $labels[$scratch{$_}[0]];
245 push(@keep_i, @{$scratch{$_}});
248 @labels = @labels[@keep_i];
260 HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
264 use HTML::CalendarMonth::Locale;
266 my $loc = HTML::CalendarMonth::Locale->new( id => 'en_US' );
268 # list of days of the week for locale
269 my @days = $loc->days;
271 # list of months of the year for locale
272 my @months = $loc->months;
274 # the name of the current locale, as supplied the id parameter to
276 my $locale_name = $loc->id;
278 # the actual DateTime::Locale object
285 HTML::CalendarMonth utilizes the powerful locale capabilities of
286 DateTime::Locale for rendering its calendars. The default locale is
287 'en_US' but many others are available. To see this list, invoke the
288 class method HTML::CalendarMonth::Locale->locales() which in turn
289 invokes DateTime::Locale::ids().
291 This module is mostly intended for internal usage within
292 HTML::CalendarMonth, but some of its functionality may be of use for
301 Constructor. Takes the following parameters:
307 Locale id, e.g. 'en_US'.
311 Specifies whether full day names or their abbreviations are desired.
312 Default 0, use abbreviated days.
316 Specifies whether full month names or their abbreviations are desired.
317 Default 1, use full months.
323 Returns the locale id used during object construction.
327 Accessor method for the DateTime::Locale class, which in turn offers
328 several class methods of specific interest. See L<DateTime::Locale>.
332 Returns a hash of all available locales, mapping their id to their
337 Accessor method for the DateTime::Locale instance as specified by C<id>.
338 See L<DateTime::Locale>.
342 Lists all available locale ids. Equivalent to locale()->ids(), or
343 DateTime::Locale->ids().
347 Returns a list of days of the week, Sunday first. These are the actual
348 unique day strings used for rendering calendars, so depending on which
349 attributes were provided to C<new()>, this list will either be
350 abbreviations or full names. The default uses abbreviated day names.
351 Returns a list in list context or an array ref in scalar context.
355 Returns a list of short day abbreviations, beginning with Sunday. The
356 narrow abbreviations are not guaranteed to be unique (i.e. 'S' for both
359 =item days_minmatch()
361 Provides a hash reference containing minimal case-insensitive match
362 strings for each day of the week, e.g., 'sa' for Saturday, 'm' for
367 Returns a list of months of the year, beginning with January. Depending
368 on which attributes were provided to C<new()>, this list will either be
369 full names or abbreviations. The default uses full names. Returns a list
370 in list context or an array ref in scalar context.
372 =item narrow_months()
374 Returns a list of short month abbreviations, beginning with January. The
375 narrow abbreviations are not guaranteed to be unique.
377 =item months_minmatch()
379 Provides a hash reference containing minimal case-insensitive match
380 strings for each month of the year, e.g., 'n' for November, 'ja' for
381 January, 'jul' for July, 'jun' for June, etc.
385 Provides a hash reference containing day of week indices for each fully
386 qualified day name as returned by days().
390 Provides the day of week index for a particular day name.
394 Provides the fully qualified day name for a given string or day index.
398 Provides a hash reference containing month of year indices for each
399 fully qualified month name as returned by months().
401 =item monthnum($month)
403 Provides the month of year index for a particular month name.
405 =item monthname($month)
407 Provides the month name for a given string or month index.
409 =item minmatch_hash(@list)
411 This is the method used to generate the case-insensitive minimal match
412 hash referenced above. Given an arbitrary list, a hash reference will
413 be returned with minimal match strings as keys and the original strings
416 =item lc_minmatch_hash(@list)
418 Same as minmatch_hash, except keys are forced to lower case.
420 =item first_day_of_week()
422 Returns a number from 0 to 6 representing the first day of the week for
423 this locale, where 0 represents Sunday.
429 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
433 Copyright (c) 2010 Matthew P. Sisk. All rights reserved. All wrongs
434 revenged. This program is free software; you can redistribute it and/or
435 modify it under the same terms as Perl itself.
439 HTML::CalendarMonth(3), DateTime::Locale(3)
441 =for Pod::Coverage minmatch minmatch_pattern