Locale-Unicode-Data

 view release on metacpan or  search on metacpan

lib/Locale/Unicode/Data.pm  view on Meta::CPAN

    table       => 'number_systems',
    has_array   => [qw( digits )],
}, @_ ) ); }

sub number_system_l10n { return( shift->_fetch_one({
    id          => 'getnumber_system_l10n',
    field       => 'number_system',
    table       => 'number_systems_l10n',
    requires    => [qw( locale alt )],
    default     => { alt => undef },
}, @_ ) ); }

sub number_systems_l10n { return( shift->_fetch_all({
    id          => 'number_systems_l10n',
    table       => 'number_systems_l10n',
    by          => [qw( locale number_system alt )],
}, @_ ) ); }

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( Locale::Unicode::Data::NullObject->new );
    }
    return;
}

sub person_name_default { return( shift->_fetch_one({
    id      => 'get_person_name_default',
    field   => 'locale',
    table   => 'person_name_defaults',
}, @_ ) ); }

sub person_name_defaults { return( shift->_fetch_all({
    id          => 'person_name_defaults',
    table       => 'person_name_defaults',
}, @_ ) ); }

# NOTE: plural rules for 222 locales based on the Unicode CDR rules set out in supplemental/plurals.xml
# This is for the method plural_count()
my $plural_rules = 
{
    # 1: other
    # bm bo dz hnj id ig ii in ja jbo jv jw kde kea km ko lkt lo ms my nqo osa root sah ses sg su th to tpi vi wo yo yue zh
    bm => { other => sub { 1 } },
    # The other locales in this group are aliased

    # 2: one, other
    # am as bn doi fa gu hi kn pcm zu
    am => 
    {
        one   => sub { $_[0] == 0 || $_[0] == 1 },
        other => sub { 1 },
    },
    # The other locales in this group are aliased

    # ff hy kab
    ff => 
    {
        one   => sub { $_[0] == 0 || $_[0] == 1 },
        other => sub { 1 },
    },
    # The other locales in this group are aliased

    # ast de en et fi fy gl ia io ji lij nl sc sv sw ur yi
    ast => 
    {

lib/Locale/Unicode/Data.pm  view on Meta::CPAN

    if( defined( $STHS ) && ref( $STHS ) eq 'HASH' )
    {
        foreach my $tid ( keys( %$STHS ) )
        {
            next unless( ref( $STHS->{ $tid } ) eq 'HASH' );
            foreach my $db ( keys( %{ $STHS->{ $tid } } ) )
            {
                next unless( ref( $STHS->{ $tid }->{ $db } ) eq 'HASH' );
                foreach my $sth ( values( %{ $STHS->{ $tid }->{ $db } } ) )
                {
                    if( defined( $sth ) &&
                        Scalar::Util::blessed( $sth ) )
                    {
                        $sth->finish;
                    }
                }
            }
        }
    }
};

sub FREEZE
{
    my $self = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class = CORE::ref( $self );
    my @keys = qw( datafile decode_sql_arrays 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 $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
{
    my $self = CORE::shift( @_ );
    my @keys = qw( datafile decode_sql_arrays );
    my $hash = {};
    @$hash{ @keys } = @$self{ @keys };
    return( $hash );
}

# NOTE: Locale::Unicode::Data::Boolean class
package Locale::Unicode::Data::Boolean;
BEGIN
{
    use strict;
    use warnings;
    use vars qw( $VERSION $true $false );
    use overload
      "0+"     => sub{ ${$_[0]} },
      "++"     => sub{ $_[0] = ${$_[0]} + 1 },
      "--"     => sub{ $_[0] = ${$_[0]} - 1 },
      fallback => 1;
    $true  = do{ bless( \( my $dummy = 1 ) => 'Locale::Unicode::Data::Boolean' ) };
    $false = do{ bless( \( my $dummy = 0 ) => 'Locale::Unicode::Data::Boolean' ) };
    our $VERSION = 'v0.1.0';
};
use strict;
use warnings;

sub new
{
    my $this = shift( @_ );
    my $self = bless( \( my $dummy = ( $_[0] ? 1 : 0 ) ) => ( ref( $this ) || $this ) );
}

sub clone
{
    my $self = shift( @_ );
    unless( ref( $self ) )
    {
        die( "clone() must be called with an object." );
    }
    my $copy = $$self;
    my $new = bless( \$copy => ref( $self ) );
    return( $new );
}

sub false() { $false }

sub is_bool($) { UNIVERSAL::isa( $_[0], 'Locale::Unicode::Data::Boolean' ) }

sub is_true($) { $_[0] && UNIVERSAL::isa( $_[0], 'Locale::Unicode::Data::Boolean' ) }

sub is_false($) { !$_[0] && UNIVERSAL::isa( $_[0], 'Locale::Unicode::Data::Boolean' ) }

sub true() { $true  }

lib/Locale/Unicode/Data.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: Locale::Unicode::Data::NullObject class
    package
        Locale::Unicode::Data::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

Locale::Unicode::Data - Unicode CLDR SQL Data

=head1 SYNOPSIS

    use Locale::Unicode::Data;
    my $cldr = Locale::Unicode::Data->new;
    # Do not decode SQL arrays into perl arrays. Defaults to true
    # This uses JSON::XS
    my $cldr = Locale::Unicode::Data->new( decode_sql_arrays => 0 );