11package HTML::CalendarMonth::Locale ;
22{
3- $HTML::CalendarMonth::Locale::VERSION = ' 1.26 '
3+ $HTML::CalendarMonth::Locale::VERSION = ' 2.00 '
44}
55
66# Front end class around DateTime::Locale. In addition to providing
@@ -14,86 +14,107 @@ use Carp;
1414
1515use DateTime::Locale 0.45;
1616
17+ sub _locale_version { $DateTime::Locale::VERSION }
18+
19+ my ($CODE_METHOD , $CODES_METHOD );
20+ if (_locale_version() > 0.46) {
21+ $CODE_METHOD = " code"
22+ $CODES_METHOD = " codes"
23+ }
24+ else {
25+ $CODE_METHOD = " id"
26+ $CODES_METHOD = " ids"
27+ }
28+
1729my %Register ;
1830
1931sub new {
2032 my $class = shift ;
2133 my $self = {};
2234 bless $self , $class ;
2335 my %parms = @_ ;
24- my $id = $parms {id } or croak " Locale id required (eg 'en_US')\n "
25- $self -> {id } = $id ;
36+ # id is for backwards compatibility
37+ my $code = $parms {code } || $parms {id }
38+ or croak " Locale code required (eg 'en-US')\n "
2639 $self -> {full_days } = defined $parms {full_days } ? $parms {full_days } : 0;
2740 $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 "
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 };
3146 }
47+ $self -> {code } = $Register {$code }{loc }-> $CODE_METHOD ;
3248 $self ;
3349}
3450
3551sub locale { ' DateTime::Locale'
3652
37- sub loc { $Register {shift -> id} }
53+ sub loc { $Register {shift -> code}{loc } }
54+
55+ sub locales { shift -> locale-> $CODES_METHOD }
3856
39- sub locales { shift -> locale-> ids }
57+ sub code { shift -> {code } }
58+ *id = *code;
4059
41- sub id { shift -> {id } }
4260sub full_days { shift -> {full_days } }
4361sub full_months { shift -> {full_months } }
4462
4563sub first_day_of_week { shift -> loc-> first_day_of_week % 7 }
4664
4765sub days {
4866 my $self = shift ;
49- my $id = $self -> id ;
50- unless ($Register {$id }{days }) {
51- my $method = $self -> full_days > 0 ? ' day_stand_alone_wide'
52- : ' day_stand_alone_abbreviated'
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'
5371 # adjust to H::CM standard expectation, 1st day Sun
5472 # Sunday is first, regardless of what the calendar considers to be
5573 # the first day of the week
5674 my @days = @{$self -> loc-> $method };
5775 unshift (@days , pop @days );
58- $Register {$id }{days } = \@days ;
76+ $Register {$code }{days } = \@days ;
5977 }
60- wantarray ? @{$Register {$id }{days }} : $Register {$id }{days };
78+ wantarray ? @{$Register {$code }{days }} : $Register {$code }{days };
6179}
6280
6381sub narrow_days {
6482 my $self = shift ;
65- my $id = $self -> id ;
66- unless ($Register {$id }{narrow_days }) {
83+ my $code = $self -> code ;
84+ unless ($Register {$code }{narrow_days }) {
6785 # Sunday is first, regardless of what the calendar considers to be
6886 # the first day of the week
6987 my @days = @{ $self -> loc-> day_stand_alone_narrow };
7088 unshift (@days , pop @days );
71- $Register {$id }{narrow_days } = \@days ;
89+ $Register {$code }{narrow_days } = \@days ;
7290 }
73- wantarray ? @{$Register {$id }{narrow_days }} : $Register {$id }{narrow_days };
91+ wantarray ? @{$Register {$code }{narrow_days }}
92+ : $Register {$code }{narrow_days };
7493}
7594
7695sub months {
7796 my $self = shift ;
78- my $id = $self -> id ;
79- unless ($Register {$id }{months }) {
97+ my $code = $self -> code ;
98+ unless ($Register {$code }{months }) {
8099 my $method = $self -> full_months > 0 ? ' month_stand_alone_wide'
81100 : ' month_stand_alone_abbreviated'
82- $Register {$id }{months } = [@{$self -> loc-> $method }];
101+ $Register {$code }{months } = [@{$self -> loc-> $method }];
83102 }
84- wantarray ? @{$Register {$id }{months }} : $Register {$id }{months };
103+ wantarray ? @{$Register {$code }{months }} : $Register {$code }{months };
85104}
86105
87106sub narrow_months {
88107 my $self = shift ;
89- my $id = $self -> id;
90- $Register {$id }{narrow_months } ||= [$self -> loc-> month_stand_alone_narrow];
91- wantarray ? @{$Register {$id }{narrow_months }} : $Register {$id }{narrow_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 };
92113}
93114
94115sub days_minmatch {
95116 my $self = shift ;
96- $Register {$self -> id }{days_mm }
117+ $Register {$self -> code }{days_mm }
97118 ||= $self -> lc_minmatch_hash($self -> days);
98119}
99120*minmatch = \&days_minmatch;
@@ -104,10 +125,9 @@ sub _days_minmatch_pattern {
104125}
105126*minmatch_pattern = \&_days_minmatch_pattern;
106127
107-
108128sub months_minmatch {
109129 my $self = shift ;
110- $Register {$self -> id }{months_mm }
130+ $Register {$self -> code }{months_mm }
111131 ||= $self -> lc_minmatch_hash($self -> months);
112132}
113133
@@ -118,14 +138,15 @@ sub _months_minmatch_pattern {
118138
119139sub daynums {
120140 my $self = shift ;
121- my $id = $self -> id ;
122- unless ($Register {$id }{daynum }) {
141+ my $code = $self -> code ;
142+ unless ($Register {$code }{daynum }) {
123143 my %daynum ;
124144 my $days = $self -> days;
125145 $daynum {$days -> [$_ ]} = $_ foreach 0 .. $# $days ;
126- $Register {$id }{daynum } = \%daynum ;
146+ $Register {$code }{daynum } = \%daynum ;
127147 }
128- $Register {$id }{daynum };
148+ wantarray ? %{$Register {$code }{daynum }}
149+ : $Register {$code }{daynum };
129150}
130151
131152sub _daymatch {
@@ -148,14 +169,15 @@ sub dayname { (shift->_daymatch(@_))[1] }
148169
149170sub monthnums {
150171 my $self = shift ;
151- my $id = $self -> id ;
152- unless ($Register {$id }{monthnum }) {
172+ my $code = $self -> code ;
173+ unless ($Register {$code }{monthnum }) {
153174 my %monthnum ;
154175 my $months = $self -> months;
155176 $monthnum {$months -> [$_ ]} = $_ foreach 0 .. $# $months ;
156- $Register {$id }{monthnum } = \%monthnum ;
177+ $Register {$code }{monthnum } = \%monthnum ;
157178 }
158- $Register {$id }{monthnum };
179+ wantarray ? %{$Register {$code }{monthnum }}
180+ : $Register {$code }{monthnum };
159181}
160182
161183sub _monthmatch {
@@ -181,8 +203,8 @@ sub monthname { (shift->_monthmatch(@_))[1] }
181203sub locale_map {
182204 my $self = shift ;
183205 my %map ;
184- foreach my $id ($self -> locales) {
185- $map {$id } = $self -> locale-> load($id )-> name;
206+ foreach my $code ($self -> locales) {
207+ $map {$code } = $self -> locale-> load($code )-> name;
186208 }
187209 wantarray ? %map : \%map ;
188210}
@@ -263,17 +285,17 @@ HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
263285
264286 use HTML::CalendarMonth::Locale;
265287
266- my $loc = HTML::CalendarMonth::Locale->new( id => 'en_US ' );
288+ my $loc = HTML::CalendarMonth::Locale->new( code => 'en-US ' );
267289
268290 # list of days of the week for locale
269291 my @days = $loc->days;
270292
271293 # list of months of the year for locale
272294 my @months = $loc->months;
273295
274- # the name of the current locale, as supplied the id parameter to
296+ # the name of the current locale, as supplied the code parameter to
275297 # new()
276- my $locale_name = $loc->id ;
298+ my $locale_name = $loc->code ;
277299
278300 # the actual DateTime::Locale object
279301 my $loc = $loc->loc;
@@ -284,9 +306,9 @@ HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
284306
285307HTML::CalendarMonth utilizes the powerful locale capabilities of
286308DateTime::Locale for rendering its calendars. The default locale is
287- 'en_US ' but many others are available. To see this list, invoke the
309+ 'en-US ' but many others are available. To see this list, invoke the
288310class method HTML::CalendarMonth::Locale->locales() which in turn
289- invokes DateTime::Locale::ids ().
311+ invokes DateTime::Locale::codes ().
290312
291313This module is mostly intended for internal usage within
292314HTML::CalendarMonth, but some of its functionality may be of use for
@@ -302,9 +324,9 @@ Constructor. Takes the following parameters:
302324
303325=over
304326
305- =item id
327+ =item code
306328
307- Locale id , e.g. 'en_US '.
329+ Locale code , e.g. 'en-US '.
308330
309331=item full_days
310332
@@ -318,9 +340,9 @@ Default 1, use full months.
318340
319341=back
320342
321- =item id ()
343+ =item code ()
322344
323- Returns the locale id used during object construction.
345+ Returns the locale code used during object construction.
324346
325347=item locale()
326348
@@ -329,18 +351,18 @@ several class methods of specific interest. See L<DateTime::Locale>.
329351
330352=item locale_map()
331353
332- Returns a hash of all available locales, mapping their id to their
354+ Returns a hash of all available locales, mapping their code to their
333355full name.
334356
335357=item loc()
336358
337- Accessor method for the DateTime::Locale instance as specified by C<id > .
359+ Accessor method for the DateTime::Locale instance as specified by C<code > .
338360See L<DateTime::Locale> .
339361
340362=item locales()
341363
342- Lists all available locale ids . Equivalent to locale()->ids (), or
343- DateTime::Locale->ids ().
364+ Lists all available locale codes . Equivalent to locale()->codes (), or
365+ DateTime::Locale->codes ().
344366
345367=item days()
346368
@@ -430,12 +452,12 @@ Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
430452
431453=head1 COPYRIGHT
432454
433- Copyright (c) 2010 Matthew P. Sisk. All rights reserved. All wrongs
455+ Copyright (c) 2015 Matthew P. Sisk. All rights reserved. All wrongs
434456revenged. This program is free software; you can redistribute it and/or
435457modify it under the same terms as Perl itself.
436458
437459=head1 SEE ALSO
438460
439461HTML::CalendarMonth(3), DateTime::Locale(3)
440462
441- =for Pod::Coverage minmatch minmatch_pattern
463+ =for Pod::Coverage minmatch minmatch_pattern id
0 commit comments