Module-Generic
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Module/Generic.pm view on Meta::CPAN
};
}
if( $@ )
{
CORE::warn( $@ ) unless( $SILENT_AUTOLOAD );
}
}
}
sub new
{
my $that = shift( @_ );
my $class = ref( $that ) || $that;
my $self = {};
no strict 'refs';
if( defined( ${ "${class}\::OBJECT_PERMS" } ) )
{
require Module::Generic::Tie;
my %hash = ();
my $obj = tie(
%hash,
'Module::Generic::Tie',
'pkg' => [ __PACKAGE__, $class ],
'perms' => ${ "${class}::OBJECT_PERMS" },
);
$self = \%hash;
}
bless( $self, $class );
if( defined( ${ "${class}\::LOG_DEBUG" } ) )
{
$self->{log_debug} = ${ "${class}::LOG_DEBUG" };
}
if( Want::want( 'OBJECT' ) )
{
return( $self->init( @_ ) );
}
my $new = $self->init( @_ );
# Returned undef; there was an error potentially
if( !defined( $new ) )
{
# If we are called on an object, we hand it the error so the caller can check it using the object:
# my $new = $old->new || die( $old->error );
if( $self->_is_object( $that ) && $that->can( 'pass_error' ) )
{
return( $that->pass_error( $self->error ) );
}
else
{
return( $self->pass_error );
}
};
return( $new );
}
sub new_glob
{
my $that = shift( @_ );
my $class = ref( $that ) || $that;
no warnings 'once';
my $self = bless( \do{ local *FH } => $class );
*$self = {};
if( defined( ${ "${class}\::LOG_DEBUG" } ) )
{
*$self->{log_debug} = ${ "${class}::LOG_DEBUG" };
}
if( Want::want( 'OBJECT' ) )
{
return( $self->init( @_ ) );
}
my $new = $self->init( @_ );
if( !defined( $new ) )
{
# If we are called on an object, we hand it the error so the caller can check it using the object:
# my $new = $old->new || die( $old->error );
if( $self->_is_object( $that ) && $that->can( 'pass_error' ) )
{
return( $that->pass_error( $self->error ) );
}
else
{
return( $self->pass_error );
}
};
return( $new );
}
sub deserialise
{
my $self = shift( @_ );
my $data;
$data = shift( @_ ) if( scalar( @_ ) && ( @_ % 2 ) );
my $opts = $self->_get_args_as_hash( @_ );
$opts->{base64} //= '';
$opts->{data} = $data if( defined( $data ) && length( $data ) );
my $this = $self->_obj2h;
my $class = $opts->{serialiser} || $opts->{serializer} || $SERIALISER;
return( $self->error( "No serialiser class was provided nor set in \$Module::Generic::SERIALISER" ) ) if( !defined( $class ) || !length( $class ) );
# Well, nothing to do
if( ( !defined( $opts->{file} ) || !length( $opts->{file} ) ) &&
( !defined( $opts->{io} ) || !length( $opts->{io} ) ) &&
( !defined( $opts->{data} ) || !length( $opts->{data} ) ) )
{
return( '' );
}
# The data provided may be composed only of null bytes, which is the case sometime
# when retrieved from memory, and in such case, there is no point passing it to
# deserialiser. Even worse, CBOR::XS does not deal with extra null padded data in the first
# place, and Sereal would not like a string made only of null bytes
elsif( CORE::exists( $opts->{data} ) &&
CORE::defined( $opts->{data} ) &&
$opts->{data} =~ /\x{00}$/ )
{
( my $temp = $opts->{data} ) =~ s/\x{00}+$//gs;
# There is nothing to do
return( '' ) if( !length( $temp ) );
}
if( $class eq 'CBOR' || $class eq 'CBOR::XS' )
{
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.474 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )