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:
305 Locale id, e.g. 'en_US'.
309 Specifies whether full day names or their abbreviations are desired.
310 Default 0, use abbreviated days.
314 Specifies whether full month names or their abbreviations are desired.
315 Default 1, use full months.
319 Returns the locale id used during object construction.
323 Accessor method for the DateTime::Locale class, which in turn offers
324 several class methods of specific interest. See L<DateTime::Locale>.
328 Returns a hash of all available locales, mapping their id to their
333 Accessor method for the DateTime::Locale instance as specified by C<id>.
334 See L<DateTime::Locale>.
338 Lists all available locale ids. Equivalent to locale()->ids(), or
339 DateTime::Locale->ids().
343 Returns a list of days of the week, Sunday first. These are the actual
344 unique day strings used for rendering calendars, so depending on which
345 attributes were provided to C<new()>, this list will either be
346 abbreviations or full names. The default uses abbreviated day names.
347 Returns a list in list context or an array ref in scalar context.
351 Returns a list of short day abbreviations, beginning with Sunday. The
352 narrow abbreviations are not guaranteed to be unique (i.e. 'S' for both
355 =item days_minmatch()
357 Provides a hash reference containing minimal case-insensitive match
358 strings for each day of the week, e.g., 'sa' for Saturday, 'm' for
363 Returns a list of months of the year, beginning with January. Depending
364 on which attributes were provided to C<new()>, this list will either be
365 full names or abbreviations. The default uses full names. Returns a list
366 in list context or an array ref in scalar context.
368 =item narrow_months()
370 Returns a list of short month abbreviations, beginning with January. The
371 narrow abbreviations are not guaranteed to be unique.
373 =item months_minmatch()
375 Provides a hash reference containing minimal case-insensitive match
376 strings for each month of the year, e.g., 'n' for November, 'ja' for
377 January, 'jul' for July, 'jun' for June, etc.
381 Provides a hash reference containing day of week indices for each fully
382 qualified day name as returned by days().
386 Provides the day of week index for a particular day name.
390 Provides the fully qualified day name for a given string or day index.
394 Provides a hash reference containing month of year indices for each
395 fully qualified month name as returned by months().
397 =item monthnum($month)
399 Provides the month of year index for a particular month name.
401 =item monthname($month)
403 Provides the month name for a given string or month index.
405 =item minmatch_hash(@list)
407 This is the method used to generate the case-insensitive minimal match
408 hash referenced above. Given an arbitrary list, a hash reference will
409 be returned with minimal match strings as keys and the original strings
412 =item lc_minmatch_hash(@list)
414 Same as minmatch_hash, except keys are forced to lower case.
416 =item first_day_of_week()
418 Returns a number from 0 to 6 representing the first day of the week for
419 this locale, where 0 represents Sunday.
425 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
429 Copyright (c) 2010 Matthew P. Sisk. All rights reserved. All wrongs
430 revenged. This program is free software; you can redistribute it and/or
431 modify it under the same terms as Perl itself.
435 HTML::CalendarMonth(3), DateTime::Locale(3)
437 =for Pod::Coverage minmatch minmatch_pattern