view release on metacpan or  search on metacpan

lib/Module/Generic/DateTime.pm  view on Meta::CPAN

    }
    return( $other );
}

sub _make_my_own
{
    my( $self, $res ) = @_;
    if( Scalar::Util::blessed( $res ) && 
        $res->isa( 'DateTime::Duration' ) )
    {
        return( Module::Generic::DateTime::Interval->new( $res ) );
    }
    elsif( Scalar::Util::blessed( $res ) && 
           $res->isa( 'DateTime' ) )
    {
        return( $self->new( $res ) );
    }
    else
    {
        return( $res );
    }
}

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 { CORE::return( CORE::shift->FREEZE( @_ ) ); }

sub STORABLE_thaw { CORE::return( CORE::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( @_ );
    CORE::return( '' ) if( !$self->{dt} || !Scalar::Util::blessed( $self->{dt} ) );
    CORE::return( $self->{dt}->stringify );
}

# NOTE: DESTROY
DESTROY {};

# NOTE: AUTOLOAD
AUTOLOAD
{
    my( $method ) = our $AUTOLOAD =~ /([^:]+)$/;
    no overloading;
    my $self = shift( @_ );
    my $class = ref( $self ) || $self;
    if( !ref( $self ) )
    {
        if( DateTime->can( $method ) )
        {
            my $rv = DateTime->$method( @_ );
            if( Scalar::Util::blessed( $rv ) && $rv->isa( 'DateTime' ) )
            {
                return( $class->new( $rv ) );
            }
            else
            {
                return( $rv );
            }
        }
        else
        {
            die( "Method ${method} unsupported by DateTime\n" );
        }
    }
    die( "DateTime object is gone !\n" ) if( !ref( $self->{dt} ) );
    no overloading;
    my $dt = $self->{dt};
    if( $dt->can( $method ) )
    {
        my $rv;
        # try-catch
        local $@;
        eval
        {
            $rv = $dt->$method( @_ );
        };
        if( $@ )
        {
            return( $self->error( "Error trying to call DateTime::$method with arguments: '", join( "', '", @_ ), "': $@" ) );
        }
        return( $rv );
    }
    else
    {