DateTime-Locale-FromCLDR
view release on metacpan or search on metacpan
lib/DateTime/Locale/FromCLDR.pm view on Meta::CPAN
my $meth_id = "number_system_digits=${num_sys}";
unless( defined( $digits = $self->{ $meth_id } ) )
{
my $cldr = $self->{_cldr} || die( "The Locale::Unicode::Data object is gone!" );
my $this = $cldr->number_system( number_system => $num_sys );
return( $self->pass_error( $cldr->error ) ) if( !defined( $this ) && $cldr->error );
if( $this )
{
$self->{ $meth_id } = $digits = $this->{digits};
}
else
{
return( $self->error( "No digits data found for numbering system '${num_sys}'" ) );
}
}
return( $digits );
}
sub pass_error
{
my $self = shift( @_ );
my $pack = ref( $self ) || $self;
my $opts = {};
my( $err, $class, $code );
no strict 'refs';
if( scalar( @_ ) )
{
# Either an hash defining a new error and this will be passed along to error(); or
# an hash with a single property: { class => 'Some::ExceptionClass' }
if( scalar( @_ ) == 1 && ref( $_[0] ) eq 'HASH' )
{
$opts = $_[0];
}
else
{
if( scalar( @_ ) > 1 && ref( $_[-1] ) eq 'HASH' )
{
$opts = pop( @_ );
}
$err = $_[0];
}
}
$err = $opts->{error} if( !defined( $err ) && CORE::exists( $opts->{error} ) && defined( $opts->{error} ) && CORE::length( $opts->{error} ) );
# We set $class only if the hash provided is a one-element hash and not an error-defining hash
$class = $opts->{class} if( CORE::exists( $opts->{class} ) && defined( $opts->{class} ) && CORE::length( $opts->{class} ) );
$code = $opts->{code} if( CORE::exists( $opts->{code} ) && defined( $opts->{code} ) && CORE::length( $opts->{code} ) );
# called with no argument, most likely from the same class to pass on an error
# set up earlier by another method; or
# with an hash containing just one argument class => 'Some::ExceptionClass'
if( !defined( $err ) && ( !scalar( @_ ) || defined( $class ) ) )
{
# $error is a previous erro robject
my $error = ref( $self ) ? $self->{error} : length( ${ $pack . '::ERROR' } ) ? ${ $pack . '::ERROR' } : undef;
if( !defined( $error ) )
{
warn( "No error object provided and no previous error set either! It seems the previous method call returned a simple undef" );
}
else
{
$err = ( defined( $class ) ? bless( $error => $class ) : $error );
$err->code( $code ) if( defined( $code ) );
}
}
elsif( defined( $err ) &&
Scalar::Util::blessed( $err ) &&
( scalar( @_ ) == 1 ||
( scalar( @_ ) == 2 && defined( $class ) )
) )
{
$self->{error} = ${ $pack . '::ERROR' } = ( defined( $class ) ? bless( $err => $class ) : $err );
$self->{error}->code( $code ) if( defined( $code ) && $self->{error}->can( 'code' ) );
if( $self->{fatal} || ( defined( ${"${class}\::FATAL_EXCEPTIONS"} ) && ${"${class}\::FATAL_EXCEPTIONS"} ) )
{
die( $self->{error} );
}
}
# If the error provided is not an object, we call error to create one
else
{
return( $self->error( @_ ) );
}
if( want( 'OBJECT' ) )
{
rreturn( DateTime::Locale::FromCLDR::NullObject->new );
}
return;
}
# sub prefers_24_hour_time
# {
# my $self = shift( @_ );
# my $bool;
# unless( defined( $bool = $self->{prefers_24_hour_time} ) )
# {
# my $pat = $self->time_format_short;
# my @parts = split( /(?:'(?:(?:[^']|'')*)')/, $pat );
# $bool = $self->{prefers_24_hour_time} = scalar( grep( /h|K/, @parts ) ) ? 0 : 1;
# }
# return( $bool );
# }
sub prefers_24_hour_time
{
my $self = shift( @_ );
my $pref = $self->time_format_preferred;
return( $self->pass_error ) if( !defined( $pref ) );
# 'H': 0-23
# 'k': 1-24
# 'h': 1-12
# 'K': 0-11
return( ( $pref eq 'H' || $pref eq 'k' ) ? 1 : 0 );
}
sub quarter_format_abbreviated { return( shift->_calendar_terms(
id => 'quarter_format_abbreviated',
type => 'quarter',
context => [qw( format stand-alone )],
width => [qw( abbreviated wide )],
) ); }
sub quarter_format_narrow { return( shift->_calendar_terms(
id => 'quarter_format_narrow',
type => 'quarter',
context => [qw( format stand-alone )],
width => [qw( narrow wide )],
) ); }
# NOTE: There is no 'short' format for quarter, but there is for 'day'
lib/DateTime/Locale/FromCLDR.pm view on Meta::CPAN
{
$ref = $cldr->timezone_names(
timezone => $timezone,
locale => $loc,
width => $width,
);
return( $self->pass_error ) if( !defined( $ref ) && $cldr->error );
if( $ref && $ref->{ $type } )
{
$name = $ref->{ $type };
last LOCALE;
}
}
# Failed to find a suitable match
$name //= '';
$self->{ $meth_id } = $name;
}
return( $name );
}
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
my $class = CORE::ref( $self );
my @keys = qw( locale calendar default_date_format_length default_time_format_length fatal );
my %hash = ();
@hash{ @keys } = @$self{ @keys };
# Return an array reference rather than a list so this works with Sereal and CBOR
# On or before Sereal version 4.023, Sereal did not support multiple values returned
CORE::return( [$class, %hash] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
# But Storable want a list with the first element being the serialised element
CORE::return( $class, \%hash );
}
sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { return( shift->THAW( @_ ) ); }
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
sub THAW
{
my( $self, undef, @args ) = @_;
my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
my $locale = Locale::Unicode->new( CORE::delete( $hash->{locale} ) // 'en' );
my $new;
# Storable pattern requires to modify the object it created rather than returning a new one
if( CORE::ref( $self ) )
{
foreach( CORE::keys( %$hash ) )
{
$self->{ $_ } = CORE::delete( $hash->{ $_ } );
}
$new = $self;
}
else
{
$new = CORE::bless( $hash => $class );
}
$new->{locale} = $locale;
$new->{_cldr} = Locale::Unicode::Data->new;
CORE::return( $new );
}
sub TO_JSON { return( shift->as_string ); }
# NOTE: DateTime::Locale::FromCLDR::Exception class
package DateTime::Locale::FromCLDR::Exception;
BEGIN
{
use strict;
use warnings;
use vars qw( $VERSION );
use overload (
'""' => 'as_string',
bool => sub{ $_[0] },
fallback => 1,
);
our $VERSION = 'v0.1.0';
};
use strict;
use warnings;
sub new
{
my $this = shift( @_ );
my $self = bless( {} => ( ref( $this ) || $this ) );
my @info = caller;
@$self{ qw( package file line ) } = @info[0..2];
my $args = {};
if( scalar( @_ ) == 1 )
{
if( ( ref( $_[0] ) || '' ) eq 'HASH' )
{
$args = shift( @_ );
if( $args->{skip_frames} )
{
@info = caller( int( $args->{skip_frames} ) );
@$self{ qw( package file line ) } = @info[0..2];
}
$args->{message} ||= '';
foreach my $k ( qw( package file line message code type retry_after ) )
{
$self->{ $k } = $args->{ $k } if( CORE::exists( $args->{ $k } ) );
}
}
elsif( ref( $_[0] ) && $_[0]->isa( 'DateTime::Locale::FromCLDR::Exception' ) )
{
my $o = $args->{object} = shift( @_ );
$self->{message} = $o->message;
$self->{code} = $o->code;
$self->{type} = $o->type;
$self->{retry_after} = $o->retry_after;
}
else
{
die( "Unknown argument provided: '", overload::StrVal( $_[0] ), "'" );
}
lib/DateTime/Locale/FromCLDR.pm view on Meta::CPAN
my $msg = shift( @_ );
$e = $self->new({
skip_frames => 1,
message => $msg,
});
}
else
{
$e = $self;
}
die( $e );
}
sub type { return( shift->reset(@_)->_set_get_prop( 'type', @_ ) ); }
sub _set_get_prop
{
my $self = shift( @_ );
my $prop = shift( @_ ) || die( "No object property was provided." );
$self->{ $prop } = shift( @_ ) if( @_ );
return( $self->{ $prop } );
}
sub FREEZE
{
my $self = CORE::shift( @_ );
my $serialiser = CORE::shift( @_ ) // '';
my $class = CORE::ref( $self );
my %hash = %$self;
# Return an array reference rather than a list so this works with Sereal and CBOR
# On or before Sereal version 4.023, Sereal did not support multiple values returned
CORE::return( [$class, \%hash] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
# But Storable want a list with the first element being the serialised element
CORE::return( $class, \%hash );
}
sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); }
sub STORABLE_thaw { return( shift->THAW( @_ ) ); }
# NOTE: CBOR will call the THAW method with the stored classname as first argument, the constant string CBOR as second argument, and all values returned by FREEZE as remaining arguments.
# NOTE: Storable calls it with a blessed object it created followed with $cloning and any other arguments initially provided by STORABLE_freeze
sub THAW
{
my( $self, undef, @args ) = @_;
my $ref = ( CORE::scalar( @args ) == 1 && CORE::ref( $args[0] ) eq 'ARRAY' ) ? CORE::shift( @args ) : \@args;
my $class = ( CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' && CORE::scalar( @$ref ) > 1 ) ? CORE::shift( @$ref ) : ( CORE::ref( $self ) || $self );
my $hash = CORE::ref( $ref ) eq 'ARRAY' ? CORE::shift( @$ref ) : {};
my $new;
# Storable pattern requires to modify the object it created rather than returning a new one
if( CORE::ref( $self ) )
{
foreach( CORE::keys( %$hash ) )
{
$self->{ $_ } = CORE::delete( $hash->{ $_ } );
}
$new = $self;
}
else
{
$new = CORE::bless( $hash => $class );
}
CORE::return( $new );
}
sub TO_JSON { return( shift->as_string ); }
{
# NOTE: DateTime::Locale::FromCLDR::NullObject class
package
DateTime::Locale::FromCLDR::NullObject;
BEGIN
{
use strict;
use warnings;
use overload (
'""' => sub{ '' },
fallback => 1,
);
use Wanted;
};
use strict;
use warnings;
sub new
{
my $this = shift( @_ );
my $ref = @_ ? { @_ } : {};
return( bless( $ref => ( ref( $this ) || $this ) ) );
}
sub AUTOLOAD
{
my( $method ) = our $AUTOLOAD =~ /([^:]+)$/;
my $self = shift( @_ );
if( want( 'OBJECT' ) )
{
rreturn( $self );
}
# Otherwise, we return undef; Empty return returns undef in scalar context and empty list in list context
return;
};
}
1;
# NOTE: POD
__END__
=encoding utf-8
=head1 NAME
DateTime::Locale::FromCLDR - DateTime/DateTime::Lite Localised Data from Unicode CLDR
=head1 SYNOPSIS
use DateTime::Locale::FromCLDR;
my $locale = DateTime::Locale::FromCLDR->new( 'ja-Kana-JP' ) ||
die( DateTime::Locale::FromCLDR->error );
my $locale = DateTime::Locale::FromCLDR->new( 'ja-Kana-JP', calendar => 'japanese' ) ||
die( DateTime::Locale::FromCLDR->error );
( run in 0.998 second using v1.01-cache-2.11-cpan-b16cb0d3907 )