1.16/lib/HTML/CalendarMonth/Locale.pm

   1 package HTML::CalendarMonth::Locale;
   2
   3 # Front end class around DateTime::Locale. In addition to providing
   4 # access to the DT::Locale class and locale-specific instance, this
   5 # class prepares some other hashes and lookups utilized by
   6 # HTML::CalendarMonth.
   7
   8 use strict;
   9 use Carp;
  10
  11 use DateTime::Locale;
  12
  13 use vars qw($VERSION);
  14 $VERSION = '0.01';
  15
  16 my %Register;
  17
  18 sub new {
  19   my $class = shift;
  20   my $self = {};
  21   bless $self, $class;
  22   my %parms = @_;
  23   my $id = $parms{id} or croak "Locale id required (eg 'en_US')\n";
  24   $self->{id} = $id;
  25   $self->{full_days}   = exists $parms{full_days}   ? $parms{full_days}   : 0;
  26   $self->{full_months} = exists $parms{full_months} ? $parms{full_months} : 1;
  27   unless ($Register{$id}) {
  28     $Register{$id} = $self->locale->load($id)
  29       or croak "Problem loading locale '$id'\n";
  30   }
  31   $self;
  32 }
  33
  34
  35 sub locale { 'DateTime::Locale' }
  36
  37 sub loc { $Register{shift->id} }
  38
  39 sub locales { shift->locale->ids }
  40
  41 sub id          { shift->{id}          }
  42 sub full_days   { shift->{full_days}   }
  43 sub full_months { shift->{full_months} }
  44
  45 sub days {
  46   my $self = shift;
  47   my $id = $self->id;
  48   unless ($Register{$id}{days}) {
  49     # we've always used Sunday as first day...
  50     my $method = $self->full_days ? 'day_names' : 'day_abbreviations';
  51     my @days = @{$self->loc->$method};
  52     unshift(@days, pop @days);
  53     $Register{$id}{days} = \@days;
  54   }
  55   wantarray ? @{$Register{$id}{days}} : $Register{$id}{days};
  56 }
  57
  58 sub months {
  59   my $self = shift;
  60   my $id = $self->id;
  61   unless ($Register{$id}{months}) {
  62     my $method = $self->full_months ? 'month_names' : 'month_abbreviations';
  63     $Register{$id}{months} = [@{$self->loc->$method}];
  64   }
  65   wantarray ? @{$Register{$id}{months}} : $Register{$id}{months};
  66 }
  67
  68 sub minmatch {
  69   my $self = shift;
  70   my $id = $self->id;
  71   unless ($Register{$id}{minmatch}) {
  72     $Register{$id}{days_minmatch} =
  73       $self->minmatch_hash(@{$self->days});
  74   }
  75   $Register{$id}{days_minmatch};
  76 }
  77
  78 sub daynums {
  79   my $self = shift;
  80   my $id = $self->id;
  81   unless ($Register{$id}{daynum}) {
  82     my %daynum;
  83     my $days = $self->days;
  84     $daynum{$days->[$_]} = $_ foreach 0 .. $#$days;
  85     $Register{$id}{daynum} = \%daynum;
  86   }
  87   $Register{$id}{daynum};
  88 }
  89
  90 sub daynum {
  91   my($self, $day) = @_;
  92   defined $day or croak "day of week label required\n";
  93   my $days = $self->days;
  94   $days->{$day} or croak "Failed daynum lookup for '$day'\n";
  95 }
  96
  97 sub monthnums {
  98   my $self = shift;
  99   my $id = $self->id;
 100   unless ($Register{$id}{monthnum}) {
 101     my %monthnum;
 102     my $months = $self->months;
 103     $monthnum{$months->[$_]} = $_ foreach 0 .. $#$months;
 104     $Register{$id}{monthnum} = \%monthnum;
 105   }
 106   $Register{$id}{monthnum};
 107 }
 108
 109 sub monthnum {
 110   my($self, $month) = @_;
 111   defined $month or croak "month label required\n";
 112   my $monthnums = $self->monthnums;
 113   $monthnums->{$month} or croak "Failed monthnum lookup for '$month'\n";
 114 }
 115
 116 ###
 117
 118 sub locale_map {
 119   my $self = shift;
 120   my %map;
 121   foreach my $id ($self->locales) {
 122     $map{$id} = $self->locale->load($id)->name;
 123   }
 124   wantarray ? %map : \%map;
 125 }
 126
 127 ###
 128
 129 sub minmatch_hash {
 130   # given a list, provide a reverse lookup of minimal values for each
 131   # label in the list
 132   my $whatever = shift;
 133   my @labels = @_;
 134   my $cc = 1;
 135   my %minmatch;
 136   while (@labels) {
 137     my %scratch;
 138     foreach my $i (0 .. $#labels) {
 139       my $str = $labels[$i];
 140       my $chrs = substr($str, 0, $cc);
 141       $scratch{$chrs} ||= [];
 142       push(@{$scratch{$chrs}}, $i);
 143     }
 144     my @keep_i;
 145     foreach (keys %scratch) {
 146       if (@{$scratch{$_}} == 1) {
 147         $minmatch{$_} = $labels[$scratch{$_}[0]];
 148       }
 149       else {
 150         push(@keep_i, @{$scratch{$_}});
 151       }
 152     }
 153     @labels = @labels[@keep_i];
 154     ++$cc;
 155   }
 156   \%minmatch;
 157 }
 158
 159 sub minmatch_pattern { join('|',keys %{shift->minmatch}) }
 160
 161 1;
 162
 163 __END__
 164
 165 =head1 NAME
 166
 167 HTML::CalendarMonth::Locale - Front end class for DateTime::Locale
 168
 169 =head1 SYNOPSIS
 170
 171   use HTML::CalendarMonth::Locale;
 172
 173   my $loc = HTML::CalendarMonth::Locale->new( id => 'en_US' );
 174
 175   # list of days of the week for locale
 176   my @days = $loc->days;
 177
 178   # list of months of the year for locale
 179   my @months = $loc->months;
 180
 181   # the name of the current locale, as supplied the id parameter to
 182   # new()
 183   my $locale_name = $loc->id;
 184
 185   # the actual DateTime::Locale object
 186   my $loc = $loc->loc;
 187
 188   1;
 189
 190 =head1 DESCRIPTION
 191
 192 HTML::CalendarMonth utilizes the powerful locale capabilities of
 193 DateTime::Locale for rendering its calendars. The default locale is
 194 'en_US' but many others are available. To see this list, invoke the
 195 class method HTML::CalendarMonth::Locale->locales() which in turn
 196 invokes DateTime::Locale::ids().
 197
 198 This module is mostly intended for internal usage within
 199 HTML::CalendarMonth, but some of its functionality may be of use for
 200 developers:
 201
 202 =head1 METHODS
 203
 204 =item new()
 205
 206 Constructor. Takes the following parameters:
 207
 208 =over
 209
 210 =item id
 211
 212 Locale id, e.g. 'en_US'.
 213
 214 =item full_days
 215
 216 Specifies whether full day names or their abbreviations are desired.
 217 Default 0, use abbreviated days.
 218
 219 =item full_months
 220
 221 Specifies whether full month names or their abbreviations are desired.
 222 Default 1, use full months.
 223
 224 =back
 225
 226 =item id()
 227
 228 Returns the locale id used during object construction.
 229
 230 =item locale()
 231
 232 Accessor method for the DateTime::Locale class, which in turn offers
 233 several class methods of specific interest. See L<DateTime::Locale>.
 234
 235 =item loc()
 236
 237 Accessor method for the DateTime::Locale instance as specified by C<id>.
 238 See L<DateTime::Locale>.
 239
 240 =item locales()
 241
 242 Lists all available locale ids. Equivalent to locale()->ids(), or
 243 DateTime::Locale->ids().
 244
 245 =item days()
 246
 247 Returns a list of days of the week, Sunday first. These are the actual
 248 days used for rendering the calendars, so depending on which attributes
 249 were provided to C<new()>, this list will either be abbreviations or
 250 full names. The default uses abbreviated day names. Returns a list in
 251 list context or an array ref in scalar context.
 252
 253 =item months()
 254
 255 Returns a list of months of the year, beginning with January. Depending
 256 on which attributes were provided to C<new()>, this list will either be
 257 full names or abbreviations. The default uses full names. Returns a list
 258 in list context or an array ref in scalar context.
 259
 260 =item minmatch()
 261
 262 Provides a hash reference containing minimal match strings for each
 263 month of the year, e.g., 'N' for November, 'Ja' for January, 'Jul' for
 264 July, 'Jun' for June, etc.
 265
 266 =item daynums()
 267
 268 Provides a hash reference containing day of week numbers for each day
 269 name.
 270
 271 =item daynum($day)
 272
 273 Provides the day of week number for a particular day name.
 274
 275 =item monthnums()
 276
 277 Provides a hash reference containing month of year numbers for each
 278 month name.
 279
 280 =item monthnum($month)
 281
 282 Provides the month of year number for a particular month name.
 283
 284 =item minmatch_hash(@list)
 285
 286 This is the method used to generate the minimal match hash referenced
 287 above. Given an arbitrary list, a hash reference will be returned with
 288 minimal match strings as keys and full names as values.
 289
 290 =head1 AUTHOR
 291
 292 Matthew P. Sisk, E<lt>F<sisk@mojotoad.com>E<gt>
 293
 294 =head1 COPYRIGHT
 295
 296 Copyright (c) 2005 Matthew P. Sisk. All rights reserved. All wrongs
 297 revenged. This program is free software; you can redistribute it and/or
 298 modify it under the same terms as Perl itself.
 299
 300 =head1 SEE ALSO
 301
 302 HTML::CalendarMonth(3), DateTime::Locale(3)