1package DateTime::Locale::Base; 2 3use strict; 4use warnings; 5 6use Carp qw( carp ); 7use DateTime::Locale; 8use List::MoreUtils (); 9use Params::Validate qw( validate_pos ); 10 11BEGIN { 12 foreach my $field ( 13 qw( id en_complete_name native_complete_name 14 en_language en_script en_territory en_variant 15 native_language native_script native_territory native_variant 16 ) 17 ) { 18 19 # remove leading 'en_' for method name 20 ( my $meth_name = $field ) =~ s/^en_//; 21 22 # also remove 'complete_' 23 $meth_name =~ s/complete_//; 24 25 no strict 'refs'; 26 *{$meth_name} = sub { $_[0]->{$field} }; 27 } 28} 29 30sub new { 31 my $class = shift; 32 33 # By making the default format lengths part of the object's hash 34 # key, it allows them to be settable. 35 return bless { 36 @_, 37 default_date_format_length => $class->_default_date_format_length(), 38 default_time_format_length => $class->_default_time_format_length(), 39 }, $class; 40} 41 42sub language_id { ( DateTime::Locale::_parse_id( $_[0]->id ) )[0] } 43sub script_id { ( DateTime::Locale::_parse_id( $_[0]->id ) )[1] } 44sub territory_id { ( DateTime::Locale::_parse_id( $_[0]->id ) )[2] } 45sub variant_id { ( DateTime::Locale::_parse_id( $_[0]->id ) )[3] } 46 47my @FormatLengths = qw( short medium long full ); 48 49sub date_format_default { 50 my $meth = 'date_format_' . $_[0]->default_date_format_length(); 51 $_[0]->$meth(); 52} 53 54sub date_formats { 55 return { 56 map { 57 my $meth = 'date_format_' . $_; 58 $_ => $_[0]->$meth() 59 } @FormatLengths 60 }; 61} 62 63sub time_format_default { 64 my $meth = 'time_format_' . $_[0]->default_time_format_length(); 65 $_[0]->$meth(); 66} 67 68sub time_formats { 69 return { 70 map { 71 my $meth = 'time_format_' . $_; 72 $_ => $_[0]->$meth() 73 } @FormatLengths 74 }; 75} 76 77sub format_for { 78 my $self = shift; 79 my $for = shift; 80 81 my $meth = '_format_for_' . $for; 82 83 return unless $self->can($meth); 84 85 return $self->$meth(); 86} 87 88sub available_formats { 89 my $self = shift; 90 91 # The various parens seem to be necessary to force uniq() to see 92 # the caller's list context. Go figure. 93 my @uniq 94 = List::MoreUtils::uniq( 95 map { keys %{ $_->_available_formats() || {} } } 96 _self_and_super_path( ref $self ) ); 97 98 # Doing the sort in the same expression doesn't work under 5.6.x. 99 return sort @uniq; 100} 101 102# Copied wholesale from Class::ISA, because said module warns as deprecated 103# with perl 5.11.0+, which is kind of annoying. 104sub _self_and_super_path { 105 # Assumption: searching is depth-first. 106 # Assumption: '' (empty string) can't be a class package name. 107 # Note: 'UNIVERSAL' is not given any special treatment. 108 return () unless @_; 109 110 my @out = (); 111 112 my @in_stack = ($_[0]); 113 my %seen = ($_[0] => 1); 114 115 my $current; 116 while(@in_stack) { 117 next unless defined($current = shift @in_stack) && length($current); 118 push @out, $current; 119 no strict 'refs'; 120 unshift @in_stack, 121 map 122 { my $c = $_; # copy, to avoid being destructive 123 substr($c,0,2) = "main::" if substr($c,0,2) eq '::'; 124 # Canonize the :: -> main::, ::foo -> main::foo thing. 125 # Should I ever canonize the Foo'Bar = Foo::Bar thing? 126 $seen{$c}++ ? () : $c; 127 } 128 @{"$current\::ISA"} 129 ; 130 # I.e., if this class has any parents (at least, ones I've never seen 131 # before), push them, in order, onto the stack of classes I need to 132 # explore. 133 } 134 135 return @out; 136} 137 138# Just needed for the above method. 139sub _available_formats { } 140 141sub default_date_format_length { $_[0]->{default_date_format_length} } 142 143sub set_default_date_format_length { 144 my $self = shift; 145 my ($l) 146 = validate_pos( @_, { regex => qr/^(?:full|long|medium|short)$/i } ); 147 148 $self->{default_date_format_length} = lc $l; 149} 150 151sub default_time_format_length { $_[0]->{default_time_format_length} } 152 153sub set_default_time_format_length { 154 my $self = shift; 155 my ($l) 156 = validate_pos( @_, { regex => qr/^(?:full|long|medium|short)/i } ); 157 158 $self->{default_time_format_length} = lc $l; 159} 160 161for my $length (qw( full long medium short )) { 162 my $key = 'datetime_format_' . $length; 163 164 my $sub = sub { 165 my $self = shift; 166 167 return $self->{$key} if exists $self->{$key}; 168 169 my $date_meth = 'date_format_' . $length; 170 my $time_meth = 'time_format_' . $length; 171 172 return $self->{$key} 173 = $self->_make_datetime_format( $date_meth, $time_meth ); 174 }; 175 176 no strict 'refs'; 177 *{$key} = $sub; 178} 179 180sub datetime_format_default { 181 my $self = shift; 182 183 my $date_meth = 'date_format_' . $self->default_date_format_length(); 184 my $time_meth = 'time_format_' . $self->default_time_format_length(); 185 186 return $self->_make_datetime_format( $date_meth, $time_meth ); 187} 188 189sub _make_datetime_format { 190 my $self = shift; 191 my $date_meth = shift; 192 my $time_meth = shift; 193 194 my $dt_format = $self->datetime_format(); 195 196 my $time = $self->$time_meth(); 197 my $date = $self->$date_meth(); 198 199 $dt_format =~ s/\{0\}/$time/g; 200 $dt_format =~ s/\{1\}/$date/g; 201 202 return $dt_format; 203} 204 205sub prefers_24_hour_time { 206 my $self = shift; 207 208 return $self->{prefers_24_hour_time} 209 if exists $self->{prefers_24_hour_time}; 210 211 $self->{prefers_24_hour_time} 212 = $self->time_format_short() =~ /h|K/ ? 0 : 1; 213} 214 215# Backwards compat for DateTime.pm version <= 0.42 216{ 217 my %subs = ( 218 month_name => sub { $_[0]->month_format_wide()->[ $_[1]->month_0 ] }, 219 220 month_abbreviation => sub { 221 $_[0]->month_format_abbreviated()->[ $_[1]->month_0 ]; 222 }, 223 month_narrow => 224 sub { $_[0]->month_format_narrow()->[ $_[1]->month_0 ]; }, 225 226 month_names => sub { $_[0]->month_format_wide() }, 227 month_abbreviations => sub { $_[0]->month_format_abbreviated() }, 228 month_narrows => sub { $_[0]->month_format_narrow() }, 229 230 day_name => 231 sub { $_[0]->day_format_wide()->[ $_[1]->day_of_week_0 ] }, 232 233 day_abbreviation => sub { 234 $_[0]->day_format_abbreviated()->[ $_[1]->day_of_week_0 ]; 235 }, 236 day_narrow => 237 sub { $_[0]->day_format_narrow()->[ $_[1]->day_of_week_0 ]; }, 238 239 day_names => sub { $_[0]->day_format_wide() }, 240 day_abbreviations => sub { $_[0]->day_format_abbreviated() }, 241 day_narrows => sub { $_[0]->day_format_narrow() }, 242 243 quarter_name => 244 sub { $_[0]->quarter_format_wide()->[ $_[1]->quarter - 1 ] }, 245 246 quarter_abbreviation => sub { 247 $_[0]->quarter_format_abbreviated()->[ $_[1]->quarter - 1 ]; 248 }, 249 quarter_narrow => 250 sub { $_[0]->quarter_format_narrow()->[ $_[1]->quarter - 1 ] }, 251 252 quarter_names => sub { $_[0]->quarter_format_wide() }, 253 quarter_abbreviations => sub { $_[0]->quarter_format_abbreviated() }, 254 255 am_pm => 256 sub { $_[0]->am_pm_abbreviated()->[ $_[1]->hour < 12 ? 0 : 1 ] }, 257 am_pms => sub { $_[0]->am_pm_abbreviated() }, 258 259 era_name => sub { $_[0]->era_wide()->[ $_[1]->ce_year < 0 ? 0 : 1 ] }, 260 261 era_abbreviation => sub { 262 $_[0]->era_abbreviated()->[ $_[1]->ce_year < 0 ? 0 : 1 ]; 263 }, 264 era_narrow => 265 sub { $_[0]->era_narrow()->[ $_[1]->ce_year < 0 ? 0 : 1 ] }, 266 267 era_names => sub { $_[0]->era_wide() }, 268 era_abbreviations => sub { $_[0]->era_abbreviated() }, 269 270 # ancient backwards compat 271 era => sub { $_[0]->era_abbreviation }, 272 eras => sub { $_[0]->era_abbreviations }, 273 274 date_before_time => sub { 275 my $self = shift; 276 277 my $dt_format = $self->datetime_format(); 278 279 return $dt_format =~ /\{1\}.*\{0\}/ ? 1 : 0; 280 }, 281 282 date_parts_order => sub { 283 my $self = shift; 284 285 my $short = $self->date_format_short(); 286 287 $short =~ tr{dmyDMY}{}cd; 288 $short =~ tr{dmyDMY}{dmydmy}s; 289 290 return $short; 291 }, 292 293 full_date_format => sub { 294 $_[0]->_convert_to_strftime( $_[0]->date_format_full() ); 295 }, 296 297 long_date_format => sub { 298 $_[0]->_convert_to_strftime( $_[0]->date_format_long() ); 299 }, 300 301 medium_date_format => sub { 302 $_[0]->_convert_to_strftime( $_[0]->date_format_medium() ); 303 }, 304 305 short_date_format => sub { 306 $_[0]->_convert_to_strftime( $_[0]->date_format_short() ); 307 }, 308 309 default_date_format => sub { 310 $_[0]->_convert_to_strftime( $_[0]->date_format_default() ); 311 }, 312 313 full_time_format => sub { 314 $_[0]->_convert_to_strftime( $_[0]->time_format_full() ); 315 }, 316 317 long_time_format => sub { 318 $_[0]->_convert_to_strftime( $_[0]->time_format_long() ); 319 }, 320 321 medium_time_format => sub { 322 $_[0]->_convert_to_strftime( $_[0]->time_format_medium() ); 323 }, 324 325 short_time_format => sub { 326 $_[0]->_convert_to_strftime( $_[0]->time_format_short() ); 327 }, 328 329 default_time_format => sub { 330 $_[0]->_convert_to_strftime( $_[0]->time_format_default() ); 331 }, 332 333 full_datetime_format => sub { 334 $_[0]->_convert_to_strftime( $_[0]->datetime_format_full() ); 335 }, 336 337 long_datetime_format => sub { 338 $_[0]->_convert_to_strftime( $_[0]->datetime_format_long() ); 339 }, 340 341 medium_datetime_format => sub { 342 $_[0]->_convert_to_strftime( $_[0]->datetime_format_medium() ); 343 }, 344 345 short_datetime_format => sub { 346 $_[0]->_convert_to_strftime( $_[0]->datetime_format_short() ); 347 }, 348 349 default_datetime_format => sub { 350 $_[0]->_convert_to_strftime( $_[0]->datetime_format_default() ); 351 }, 352 ); 353 354 for my $name ( keys %subs ) { 355 my $real_sub = $subs{$name}; 356 357 my $sub = sub { 358 carp 359 "The $name method in DateTime::Locale::Base has been deprecated. Please see the DateTime::Locale distribution's Changes file for details"; 360 return shift->$real_sub(@_); 361 }; 362 363 no strict 'refs'; 364 *{$name} = $sub; 365 } 366} 367 368# Older versions of DateTime.pm will not pass in the $cldr_ok flag, so 369# we will give them the converted-to-strftime pattern (bugs and all). 370sub _convert_to_strftime { 371 my $self = shift; 372 my $pattern = shift; 373 my $cldr_ok = shift; 374 375 return $pattern if $cldr_ok; 376 377 return $self->{_converted_patterns}{$pattern} 378 if exists $self->{_converted_patterns}{$pattern}; 379 380 return $self->{_converted_patterns}{$pattern} 381 = $self->_cldr_to_strftime($pattern); 382} 383 384{ 385 my @JavaPatterns = ( 386 qr/G/ => '{era}', 387 qr/yyyy/ => '{ce_year}', 388 qr/y/ => 'y', 389 qr/u/ => 'Y', 390 qr/MMMM/ => 'B', 391 qr/MMM/ => 'b', 392 qr/MM/ => 'm', 393 qr/M/ => '{month}', 394 qr/dd/ => 'd', 395 qr/d/ => '{day}', 396 qr/hh/ => 'l', 397 qr/h/ => '{hour_12}', 398 qr/HH/ => 'H', 399 qr/H/ => '{hour}', 400 qr/mm/ => 'M', 401 qr/m/ => '{minute}', 402 qr/ss/ => 'S', 403 qr/s/ => '{second}', 404 qr/S/ => 'N', 405 qr/EEEE/ => 'A', 406 qr/E/ => 'a', 407 qr/D/ => 'j', 408 qr/F/ => '{weekday_of_month}', 409 qr/w/ => 'V', 410 qr/W/ => '{week_month}', 411 qr/a/ => 'p', 412 qr/k/ => '{hour_1}', 413 qr/K/ => '{hour_12_0}', 414 qr/z/ => '{time_zone_long_name}', 415 ); 416 417 sub _cldr_to_strftime { 418 shift; 419 my $simple = shift; 420 421 $simple 422 =~ s/(G+|y+|u+|M+|d+|h+|H+|m+|s+|S+|E+|D+|F+|w+|W+|a+|k+|K+|z+)|'((?:[^']|'')*)'/ 423 $2 ? _stringify($2) : $1 ? _convert($1) : "'"/eg; 424 425 return $simple; 426 } 427 428 sub _convert { 429 my $simple = shift; 430 431 for ( my $x = 0; $x < @JavaPatterns; $x += 2 ) { 432 return '%' . $JavaPatterns[ $x + 1 ] 433 if $simple =~ /$JavaPatterns[$x]/; 434 } 435 436 die "**Dont know $simple***"; 437 } 438 439 sub _stringify { 440 my $string = shift; 441 442 $string =~ s/%(?:[^%])/%%/g; 443 $string =~ s/\'\'/\'/g; 444 445 return $string; 446 } 447} 448 449# end backwards compat 450 451sub STORABLE_freeze { 452 my $self = shift; 453 my $cloning = shift; 454 455 return if $cloning; 456 457 return $self->id(); 458} 459 460sub STORABLE_thaw { 461 my $self = shift; 462 my $cloning = shift; 463 my $serialized = shift; 464 465 my $obj = DateTime::Locale->load($serialized); 466 467 %$self = %$obj; 468 469 return $self; 470} 471 4721; 473 474__END__ 475 476=head1 NAME 477 478DateTime::Locale::Base - Base class for individual locale objects 479 480=head1 SYNOPSIS 481 482 use base 'DateTime::Locale::Base'; 483 484=head1 DEFAULT FORMATS 485 486Each locale has a set of four default date and time formats. They are 487distinguished by length, and are called "full", "long", "medium", and 488"short". Each locale may have a different default length which it uses 489when its C<< $locale->date_format_default() >>, C<< 490$locale->time_format_default() >>, or C<< 491$locale->datetime_format_default() >> methods are called. 492 493This can be changed by calling the C<< 494$locale->set_default_date_format() >> or C<< 495$locale->set_default_time_format() >> methods. These methods accept a 496string which must be one of "full", "long", "medium", or "short". 497 498=head1 NAME FORMS 499 500Most names come in a number of variations. First, they may vary based 501on length, with wide, abbreviated, and narrow forms. The wide form is 502typically the full name, while the narrow form is often a single 503character. The narrow forms may not be unique. For example, "T" may be 504used for Tuesday and Thursday in the English narrow forms. 505 506Many names also distinguish between "format" and "stand-alone" forms 507of a pattern. The format pattern is used when the thing in question is 508being placed into a larger string. The stand-alone form is used when 509displaying that item by itself, for example in a calendar. 510 511=head1 METHODS 512 513All locales provide the following methods: 514 515=over 4 516 517=item * $locale->id() 518 519The locale's id. 520 521=item * $locale->language_id() 522 523The language portion of the id. 524 525=item * $locale->script_id() 526 527The script portion of the id, if any. 528 529=item * $locale->territory_id() 530 531The territory portion of the id, if any. 532 533=item * $locale->variant_id() 534 535The variant portion of the id, if any. 536 537=item * $locale->name() 538 539The full name for the locale in English. 540 541=item * $locale->language() 542 543The language name for the locale in English. 544 545=item * $locale->script() 546 547The script name for the locale in English, if any. 548 549=item * $locale->territory() 550 551The territory name for the locale in English, if any. 552 553=item * $locale->variant() 554 555The variant name for the locale in English, if any. 556 557=item * $locale->native_name() 558 559The full name for the locale in its native language, if any. 560 561=item * $locale->native_language() 562 563The language name for the locale in its native language, if any. 564 565=item * $locale->native_script() 566 567The script name for the locale in its native language, if any. 568 569=item * $locale->native_territory() 570 571The territory name for the locale in its native language, if any. 572 573=item * $locale->native_variant() 574 575The variant name for the locale in its native language, if any. 576 577=item * $locale->month_format_wide() 578 579Returns an array reference containing the wide format names of the 580months, with January as the first month. 581 582=item * $locale->month_format_abbreviated() 583 584Returns an array reference containing the abbreviated format names of 585the months, with January as the first month. 586 587=item * $locale->month_format_narrow() 588 589Returns an array reference containing the narrow format names of the 590months, with January as the first month. 591 592=item * $locale->month_stand_alone_wide() 593 594Returns an array reference containing the wide stand-alone names of 595the months, with January as the first month. 596 597=item * $locale->month_stand_alone_abbreviated() 598 599Returns an array reference containing the abbreviated stand-alone 600names of the months, with January as the first month. 601 602=item * $locale->month_stand_alone_narrow() 603 604Returns an array reference containing the narrow stand-alone names of the 605months, with January as the first month. 606 607=item * $locale->day_format_wide() 608 609Returns an array reference containing the wide format names of the 610days, with Monday as the first day. 611 612=item * $locale->day_format_abbreviated() 613 614Returns an array reference containing the abbreviated format names of 615the days, with Monday as the first day. 616 617=item * $locale->day_format_narrow() 618 619Returns an array reference containing the narrow format names of the 620days, with Monday as the first day. 621 622=item * $locale->day_stand_alone_wide() 623 624Returns an array reference containing the wide stand-alone names of 625the days, with Monday as the first day. 626 627=item * $locale->day_stand_alone_abbreviated() 628 629Returns an array reference containing the abbreviated stand-alone 630names of the days, with Monday as the first day. 631 632=item * $locale->day_stand_alone_narrow() 633 634Returns an array reference containing the narrow stand-alone names of 635the days, with Monday as the first day. 636 637=item * $locale->quarter_format_wide() 638 639Returns an array reference containing the wide format names of the 640quarters. 641 642=item * $locale->quarter_format_abbreviated() 643 644Returns an array reference containing the abbreviated format names of 645the quarters. 646 647=item * $locale->quarter_format_narrow() 648 649Returns an array reference containing the narrow format names of the 650quarters. 651 652=item * $locale->quarter_stand_alone_wide() 653 654Returns an array reference containing the wide stand-alone names of 655the quarters. 656 657=item * $locale->quarter_stand_alone_abbreviated() 658 659Returns an array reference containing the abbreviated stand-alone 660names of the quarters. 661 662=item * $locale->quarter_stand_alone_narrow() 663 664Returns an array reference containing the narrow stand-alone names of the 665quarters. 666 667=item * $locale->era_wide() 668 669Returns an array reference containing the wide names of the eras, with 670"BCE" first. 671 672=item * $locale->era_abbreviated() 673 674Returns an array reference containing the abbreviated names of the 675eras, with "BCE" first. 676 677=item * $locale->era_narrow() 678 679Returns an array reference containing the abbreviated names of the 680eras, with "BCE" first. However, most locales do not differ between 681the narrow and abbreviated length of the era. 682 683=item * $locale->am_pm_abbreviated() 684 685Returns an array reference containing the abbreviated names of "AM" 686and "PM". 687 688=item * $locale->date_format_long() 689 690=item * $locale->date_format_full() 691 692=item * $locale->date_format_medium() 693 694=item * $locale->date_format_short() 695 696Returns the CLDR date pattern of the appropriate length. 697 698=item * $locale->date_formats() 699 700Returns a hash reference of CLDR date patterns for the date formats, 701where the keys are "full", "long", "medium", and "short". 702 703=item * $locale->time_format_long() 704 705=item * $locale->time_format_full() 706 707=item * $locale->time_format_medium() 708 709=item * $locale->time_format_short() 710 711Returns the CLDR date pattern of the appropriate length. 712 713=item * $locale->time_formats() 714 715Returns a hash reference of CLDR date patterns for the time formats, 716where the keys are "full", "long", "medium", and "short". 717 718=item * $locale->datetime_format_long() 719 720=item * $locale->datetime_format_full() 721 722=item * $locale->datetime_format_medium() 723 724=item * $locale->datetime_format_short() 725 726Returns the CLDR date pattern of the appropriate length. 727 728=item * $locale->datetime_formats() 729 730Returns a hash reference of CLDR date patterns for the datetime 731formats, where the keys are "full", "long", "medium", and "short". 732 733=item * $locale->date_format_default() 734 735=item * $locale->time_format_default() 736 737=item * $locale->datetime_format_default() 738 739Returns the default CLDR date pattern. The length of this format is 740based on the value of C<< $locale->default_date_format_length() >> 741and/or C<< $locale->default_time_format_length() >>. 742 743=item * $locale->default_date_format_length() 744 745=item * $locale->default_time_format_length() 746 747Returns the default length for the format, one of "full", "long", 748"medium", or "short". 749 750=item * $locale->set_default_date_format_length() 751 752=item * $locale->set_default_time_format_length() 753 754Sets the default length for the format. This must be one of "full", 755"long", "medium", or "short". 756 757=item * $locale->prefers_24_hour_time() 758 759Returns a boolean indicating the preferred hour format for this 760locale. 761 762=item * $locale->first_day_of_week() 763 764Returns a number from 1 to 7 indicating the I<local> first day of the week, 765with Monday being 1 and Sunday being 7. For example, for a US locale this 766returns 7. 767 768=item * $locale->available_formats() 769 770A list of format names, like "MMdd" or "yyyyMM". This should be the 771list directly supported by the subclass, not its parents. 772 773=item * $locale->format_for($key) 774 775Given a valid name, returns the CLDR date pattern for that thing, if 776one exists. 777 778=back 779 780=head1 SUPPORT 781 782See L<DateTime::Locale>. 783 784=head1 AUTHORS 785 786Richard Evans <rich@ridas.com> 787 788Dave Rolsky <autarch@urth.org> 789 790=head1 COPYRIGHT 791 792Copyright (c) 2003 Richard Evans. Copyright (c) 2004-2005 David 793Rolsky. All rights reserved. This program is free software; you can 794redistribute it and/or modify it under the same terms as Perl itself. 795 796This program is free software; you can redistribute it and/or modify 797it under the same terms as Perl itself. 798 799The full text of the license can be found in the LICENSE file included 800with this module. 801 802=cut 803