view release on metacpan or  search on metacpan

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

    }
    # Otherwise some reference data to which we cannot compare
    return(0) ;
}

sub FREEZE
{
    my $self = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class = CORE::ref( $self );
    # We purposely exclude the trace object to save space.
    my @props = qw( cause code debug file lang line message package retry_after skip_frames subroutine type );
    my $hash  = {};
    foreach my $prop ( @props )
    {
        if( exists( $self->{ $prop } ) )
        {
            $hash->{ $prop } = $self->{ $prop };
        }
    }
    # 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
    if( $serialiser eq 'Sereal' )
    {
        require Sereal::Encoder;
        require version;
    
        if( version->parse( Sereal::Encoder->VERSION ) <= version->parse( '4.023' ) )
        {
            CORE::return( [$class, $hash] );
        }
    }
    # 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 ); }

sub UNIVERSAL::exception
{
    my $class = shift( @_ );
    my $me = __PACKAGE__;
    my $opts = $me->_get_args_as_hash( @_ );
    $opts->{extends} //= $me;
    my $rv = $class->create_class( %$opts ) || die( Module::Generic->error );
    return( $rv );
}

1;
# NOTE: POD
__END__
=encoding utf8

=head1 NAME

Module::Generic::Exception - Generic Module Exception Class

=head1 SYNOPSIS

    my $ex = Module::Generic::Exception->new({
        code => 404,
        type => $error_type,
        file => '/home/joe/some/lib/My/Module.pm',
        lang => 'en_GB',
        # or alternatively
        # locale => 'en_GB',
        line => 120,
        message => 'Invalid property provided',
        package => 'My::Module',
        subroutine => 'customer_info',
        # Some optional discretionary metadata hash reference
        cause =>
        {
            object => $some_object,
            payload => $raw_data,
        },
    });

or, providing a list of string that will be concatenated:

    my $ex = Module::Generic::Exception->new( "Some error", "has occurred:", $details );

or, re-using an exception object:

    my $ex = Module::Generic::Exception->new( $other_exception_object );

    print( "Error stack trace: ", $ex->stack_trace, "\n" );
    # or
    $object->customer_orders || die( "Error in file ", $object->error->file, " at line ", $object->error->line, "\n" );
    # or simply:
    $object->customer_orders || die( "Error: ", $object->error, "\n" );
    $ex->cause->payload;