DateTime-Format-Unicode
1 match

 view release on metacpan or  search on metacpan

lib/DateTime/Format/Unicode.pm  view on Meta::CPAN 

        my $on_error = shift( @_ );
        if( defined( $on_error ) )
        {
            unless( ref( $on_error ) eq 'CODE' ||
                    $on_error eq 'fatal' )
            {
                return( $self->error( "The value for 'on_error' can only be either a code reference, such as an ananonymous subroutine or a reference to an existing subroutine, or the string 'fatal', or an undefined value." ) );
            }
            $self->{on_error} = $on_error;
        }
        else
        {
            delete( $self->{on_error} );
        }
    }
    return( $self->{on_error} );
}

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

sub pattern
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $pattern = shift( @_ );
        defined( $pattern ) || return( $self->error( "Pattern provided is empty." ) );
        $self->{pattern} = $pattern;
    }
    return( $self->{pattern} );
}

sub time_zone
{
    my $self = shift( @_ );
    if( @_ )
    {
        my $tz = shift( @_ );
        local $@;
        unless( Scalar::Util::blessed( $tz ) &&
                $tz->isa( 'DateTime::TimeZone' ) )
        {
            # try-catch
            eval
            {
                require DateTime::TimeZone;
            } || return( $self->error( "Unable to load the module DateTime::TimeZone: $@" ) );

            # try-catch
            $tz = eval
            {
                DateTime::TimeZone->new( name => "${tz}" );
            } || return( $self->error( "Unable to instantiate a new DateTime::TimeZone object from '${tz}': ", ( $@ || 'unknown error' ) ) );
        }
        $self->{time_zone} = $tz;
    }
    return( $self->{time_zone} );
}

# NOTE: pattern a

lib/DateTime/Format/Unicode.pm  view on Meta::CPAN 

    return( join( '', @parts ) );
}

sub FREEZE
{
    my $self = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class = CORE::ref( $self );
    my @keys = qw( locale time_zone pattern );
    my $hash = {};
    @$hash{ @keys } = @$self{ @keys };
    $hash->{on_error} = $self->{on_error} if( exists( $self->{on_error} ) && !ref( $self->{on_error} ) );
    $hash->{time_zone} = $hash->{time_zone}->name if( Scalar::Util::blessed( $hash->{time_zone} ) && $hash->{time_zone}->isa( 'DateTime::TimeZone' ) );
    $hash->{locale} = "$hash->{locale}" if( defined( $hash->{locale} ) );
    # 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 ) : {};
    if( $hash->{locale} )
    {
        $hash->{locale} = Locale::Unicode->new( $hash->{locale} );
        $hash->{_unicode} = DateTime::Locale::FromCLDR->new( $hash->{locale} );
    }
    if( $hash->{time_zone} )
    {
        local $@;
        # try-catch
        $hash->{time_zone} = eval
        {
            require DateTime::TimeZone;
            DateTime::TimeZone->new( name => $hash->{time_zone} );
        };
    }
    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( locale time_zone pattern );
    my $hash = {};
    @$hash{ @keys } = @$self{ @keys };
    $hash->{on_error} = $self->{on_error} if( exists( $self->{on_error} ) && !ref( $self->{on_error} ) );
    $hash->{time_zone} = $hash->{time_zone}->name if( Scalar::Util::blessed( $hash->{time_zone} ) && $hash->{time_zone}->isa( 'DateTime::TimeZone' ) );
    return( $hash );
}

# NOTE: DateTime::Format::Unicode::Exception class
package DateTime::Format::Unicode::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::Format::Unicode::Exception' ) )
        {
            my $o = $args->{object} = shift( @_ );
            $self->{message} = $o->message;
            $self->{code} = $o->code;

lib/DateTime/Format/Unicode.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::Format::Unicode::NullObject class
    package
        DateTime::Format::Unicode::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::Format::Unicode - Unicode CLDR Formatter for DateTime

=head1 SYNOPSIS

    use DateTime::Format::Unicode;
    my $fmt = DateTime::Format::Unicode->new(
        locale      => 'ja-Kana-JP',
        # optional, defaults to the locale medium size date formatting
        # See: DateTime::Locale::FromCLDR for more information



( run in 1.625 second using v1.01-cache-2.11-cpan-f56aa216473 )