1 package HTML::CalendarMonth::Locale;
3 $HTML::CalendarMonth::Locale::VERSION = '2.00';
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;
17 sub _locale_version { $DateTime::Locale::VERSION }
19 my($CODE_METHOD, $CODES_METHOD);
20 if (_locale_version() > 0.92) {
21 $CODE_METHOD = "code";
22 $CODES_METHOD = "codes";
26 $CODES_METHOD = "ids";
36 # id is for backwards compatibility
37 my $code = $parms{code} || $parms{id}
38 or croak "Locale code required (eg 'en-US')\n";
39 $self->{full_days} = defined $parms{full_days} ? $parms{full_days} : 0;
40 $self->{full_months} = defined $parms{full_months} ? $parms{full_months} : 1;
41 # returned code might be different from given code
42 unless ($Register{$code}) {
43 my $dtl = $self->locale->load($code)
44 or croak "Problem loading locale '$code'";
45 $Register{$code} = $Register{$dtl->$CODE_METHOD} = { loc => $dtl };
47 $self->{code} = $Register{$code}{loc}->$CODE_METHOD;
51 sub locale { 'DateTime::Locale' }
53 sub loc { $Register{shift->code}{loc} }
55 sub locales { shift->locale->$CODES_METHOD }
57 sub code { shift->{code} }
60 sub full_days { shift->{full_days} }
61 sub full_months { shift->{full_months} }
63 sub first_day_of_week { shift->loc->first_day_of_week % 7 }
67 my $code = $self->code;
68 unless ($Register{$code}{days}) {
69 my $method = $self->full_days ? 'day_stand_alone_wide'
70 : 'day_stand_alone_abbreviated';
71 # adjust to H::CM standard expectation, 1st day Sun
72 # Sunday is first, regardless of what the calendar considers to be
73 # the first day of the week
74 my @days = @{$self->loc->$method};
75 unshift(@days, pop @days);
76 $Register{$code}{days} = \@days;
78 wantarray ? @{$Register{$code}{days}} : $Register{$code}{days};
83 my $code = $self->code;
84 unless ($Register{$code}{narrow_days}) {
85 # Sunday is first, regardless of what the calendar considers to be
86 # the first day of the week
87 my @days = @{ $self->loc->day_stand_alone_narrow };
88 unshift(@days, pop @days);
89 $Register{$code}{narrow_days} = \@days;
91 wantarray ? @{$Register{$code}{narrow_days}}
92 : $Register{$code}{narrow_days};
97 my $code = $self->code;
98 unless ($Register{$code}{months}) {
99 my $method = $self->full_months > 0 ? 'month_stand_alone_wide'
100 : 'month_stand_alone_abbreviated';
101 $Register{$code}{months} = [@{$self->loc->$method}];
103 wantarray ? @{$Register{$code}{months}} : $Register{$code}{months};
108 my $code = $self->code;
109 $Register{$code}{narrow_months}
110 ||= [@{$self->loc->month_stand_alone_narrow}];
111 wantarray ? @{$Register{$code}{narrow_months}}
112 : $Register{$code}{narrow_months};
117 $Register{$self->code}{days_mm}
118 ||= $self->lc_minmatch_hash($self->days);
120 *minmatch = \&days_minmatch;
122 sub _days_minmatch_pattern {
123 my $dmm = shift->days_minmatch;
124 join('|', sort keys %$dmm);
126 *minmatch_pattern = \&_days_minmatch_pattern;
128 sub months_minmatch {
130 $Register{$self->code}{months_mm}
131 ||= $self->lc_minmatch_hash($self->months);
134 sub _months_minmatch_pattern {
135 my $mmm = shift->months_minmatch;
136 join('|', sort keys %$mmm);
141 my $code = $self->code;
142 unless ($Register{$code}{daynum}) {
144 my $days = $self->days;
145 $daynum{$days->[$_]} = $_ foreach 0 .. $#$days;
146 $Register{$code}{daynum} = \%daynum;
148 wantarray ? %{$Register{$code}{daynum}}
149 : $Register{$code}{daynum};
153 my($self, $day) = @_;
154 return unless defined $day;
155 if ($day =~ /^\d+$/) {
157 return($day, $self->days->[$day]);
159 my $p = $self->_days_minmatch_pattern;
160 if ($day =~ /^($p)/i) {
161 $day = $self->days_minmatch->{lc $1};
162 return($self->daynums->{$day}, $day);
167 sub daynum { (shift->_daymatch(@_))[0] }
168 sub dayname { (shift->_daymatch(@_))[1] }
172 my $code = $self->code;
173 unless ($Register{$code}{monthnum}) {
175 my $months = $self->months;
176 $monthnum{$months->[$_]} = $_ foreach 0 .. $#$months;
177 $Register{$code}{monthnum} = \%monthnum;
179 wantarray ? %{$Register{$code}{monthnum}}
180 : $Register{$code}{monthnum};
184 my($self, $mon) = @_;
185 return unless defined $mon;
186 if ($mon =~ /^\d+$/) {
188 return($mon, $self->months->[$mon]);
190 my $p = $self->_months_minmatch_pattern;
191 if ($mon =~ /^($p)/i) {
192 $mon = $self->months_minmatch->{lc $1};
193 return($self->monthnums->{$mon}, $mon);
198 sub monthnum { (shift->_monthmatch(@_))[0] }
199 sub monthname { (shift->_monthmatch(@_))[1] }
206 foreach my $code ($self->locales) {
207 $map{$code} = $self->locale->load($code)->name;
209 wantarray ? %map : \%map;
214 sub lc_minmatch_hash {
215 # given a list, provide a reverse lookup of case-insensitive minimal
216 # values for each label in the list
217 my $whatever = shift;
218 my @orig_labels = @_;
219 my @labels = map { lc $_ } @orig_labels;
224 foreach my $i (0 .. $#labels) {
225 my $str = $labels[$i];
226 my $chrs = substr($str, 0, $cc);
227 $scratch{$chrs} ||= [];
228 push(@{$scratch{$chrs}}, $i);
231 foreach (keys %scratch) {
232 if (@{$scratch{$_}} == 1) {
233 $minmatch{$_} = $orig_labels[$scratch{$_}[0]];
236 push(@keep_i, @{$scratch{$_}});
239 @labels = @labels[@keep_i];
240 @orig_labels = @orig_labels[@keep_i];
247 # given a list, provide a reverse lookup of minimal values for each
249 my $whatever = shift;
255 foreach my $i (0 .. $#labels) {
256 my $str = $labels[$i];
257 my $chrs = substr($str, 0, $cc);
258 $scratch{$chrs} ||= [];
259 push(@{$scratch{$chrs}}, $i);
262 foreach (keys %scratch) {
263 if (@{$scratch{$_}} == 1) {
264 $minmatch{$_} = $labels[$scratch{$_}[0]];
267 push(@keep_i, @{$scratch{$_}});
270 @labels = @labels[@keep_i];
282 HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
286 use HTML::CalendarMonth::Locale;
288 my $loc = HTML::CalendarMonth::Locale->new( code => 'en-US' );
290 # list of days of the week for locale
291 my @days = $loc->days;
293 # list of months of the year for locale
294 my @months = $loc->months;
296 # the name of the current locale, as supplied the code parameter to
298 my $locale_name = $loc->code;
300 # the actual DateTime::Locale object
307 HTML::CalendarMonth utilizes the powerful locale capabilities of
308 DateTime::Locale for rendering its calendars. The default locale is
309 'en-US' but many others are available. To see this list, invoke the
310 class method HTML::CalendarMonth::Locale->locales() which in turn
311 invokes DateTime::Locale::codes().
313 This module is mostly intended for internal usage within
314 HTML::CalendarMonth, but some of its functionality may be of use for
323 Constructor. Takes the following parameters:
329 Locale code, e.g. 'en-US'.
333 Specifies whether full day names or their abbreviations are desired.
334 Default 0, use abbreviated days.
338 Specifies whether full month names or their abbreviations are desired.
339 Default 1, use full months.
345 Returns the locale code used during object construction.
349 Accessor method for the DateTime::Locale class, which in turn offers
350 several class methods of specific interest. See L<DateTime::Locale>.
354 Returns a hash of all available locales, mapping their code to their
359 Accessor method for the DateTime::Locale instance as specified by C<code>.
360 See L<DateTime::Locale>.
364 Lists all available locale codes. Equivalent to locale()->codes(), or
365 DateTime::Locale->codes().
369 Returns a list of days of the week, Sunday first. These are the actual
370 unique day strings used for rendering calendars, so depending on which
371 attributes were provided to C<new()>, this list will either be
372 abbreviations or full names. The default uses abbreviated day names.
373 Returns a list in list context or an array ref in scalar context.
377 Returns a list of short day abbreviations, beginning with Sunday. The
378 narrow abbreviations are not guaranteed to be unique (i.e. 'S' for both
381 =item days_minmatch()
383 Provides a hash reference containing minimal case-insensitive match
384 strings for each day of the week, e.g., 'sa' for Saturday, 'm' for
389 Returns a list of months of the year, beginning with January. Depending
390 on which attributes were provided to C<new()>, this list will either be
391 full names or abbreviations. The default uses full names. Returns a list
392 in list context or an array ref in scalar context.
394 =item narrow_months()
396 Returns a list of short month abbreviations, beginning with January. The
397 narrow abbreviations are not guaranteed to be unique.
399 =item months_minmatch()
401 Provides a hash reference containing minimal case-insensitive match
402 strings for each month of the year, e.g., 'n' for November, 'ja' for
403 January, 'jul' for July, 'jun' for June, etc.
407 Provides a hash reference containing day of week indices for each fully
408 qualified day name as returned by days().
412 Provides the day of week index for a particular day name.
416 Provides the fully qualified day name for a given string or day index.
420 Provides a hash reference containing month of year indices for each
421 fully qualified month name as returned by months().
423 =item monthnum($month)
425 Provides the month of year index for a particular month name.
427 =item monthname($month)
429 Provides the month name for a given string or month index.
431 =item minmatch_hash(@list)
433 This is the method used to generate the case-insensitive minimal match
434 hash referenced above. Given an arbitrary list, a hash reference will
435 be returned with minimal match strings as keys and the original strings
438 =item lc_minmatch_hash(@list)
440 Same as minmatch_hash, except keys are forced to lower case.
442 =item first_day_of_week()
444 Returns a number from 0 to 6 representing the first day of the week for
445 this locale, where 0 represents Sunday.
451 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
455 Copyright (c) 2010-2015 Matthew P. Sisk. All rights reserved. All wrongs
456 revenged. This program is free software; you can redistribute it and/or
457 modify it under the same terms as Perl itself.
461 HTML::CalendarMonth(3), DateTime::Locale(3)
463 =for Pod::Coverage minmatch minmatch_pattern id