view release on metacpan or  search on metacpan

lib/Module/Generic/File/IO.pm  view on Meta::CPAN

    if( wantarray() )
    {
        local $@;
        eval
        {
            @rv = $self->$ref( @_ );
        };
        if( $@ )
        {
            return( $self->error( "An unexpected error occurred while trying to call ${what} in list context: $@" ) );
        }
    }
    else
    {
        local $@;
        eval
        {
            $rv[0] = $self->$ref( @_ );
        };
        if( $@ )
        {
            return( $self->error( "An unexpected error occurred while trying to call ${what}: $@" ) );
        }
    }

    return( $self->error({ skip_frames => 1, message => "Error with $what: $!" }) ) if( CORE::length( $! ) && ( !scalar( @rv ) || !CORE::defined( $rv[0] ) ) );
    $self->clear_error;
    return if( ( wantarray() && !scalar( @rv ) ) || ( !wantarray() && !defined( $rv[0] ) ) );
    return( wantarray() ? @rv : $rv[0] );
}

sub DESTROY
{
    # NOTE: Storable creates a dummy object as a SCALAR instead of GLOB, so we need to check.
    shift->close if( ( Scalar::Util::reftype( $_[0] ) // '' ) eq 'GLOB' );
}

sub FREEZE
{
    my $self = CORE::shift( @_ );
    my $serialiser = CORE::shift( @_ ) // '';
    my $class = CORE::ref( $self ) || $self;
    my $args = $self->args;
    # On or before Sereal version 4.023, Sereal did not support multiple values returned
    CORE::return( [$class, \@$args] ) if( $serialiser eq 'Sereal' && Sereal::Encoder->VERSION <= version->parse( '4.023' ) );
    CORE::return( $class, \@$args )
}

# NOTE: There cannot be a STORABLE_freeze subroutine, or else Storable would trigger an error "Unexpected object type (8) in store_hook()". So Storable must do it by itself, which means it will die or if $Storable::forgive_me is set to a true value, ...
# sub STORABLE_freeze { return( shift->FREEZE( @_ ) ); }
# 
# sub STORABLE_thaw { return( shift->THAW( @_ ) ); }

# NOTE: STORABLE_freeze_pre_processing called by Storable::Improved
sub STORABLE_freeze_pre_processing
{
    my $self = CORE::shift( @_ );
    my $class = CORE::ref( $self ) || $self;
    my $args = $self->args;
    # We change the glob object into a regular hash-based one to be Storable-friendly
    my $this = CORE::bless( { args => $args, class => $class } => $class );
    CORE::return( $this );
}

sub STORABLE_thaw_post_processing
{
    my $self = CORE::shift( @_ );
    my $args = ( CORE::exists( $self->{args} ) && CORE::ref( $self->{args} ) eq 'ARRAY' )
        ? $self->{args}
        : [];
    my $class = ( CORE::exists( $self->{class} ) && CORE::defined( $self->{class} ) && CORE::length( $self->{class} ) ) 
        ? $self->{class}
        : ( CORE::ref( $self ) || $self );
    # We restore our glob object. Geez that was hard. Not.
    my $obj = $THAW_REOPENS_FILE ? $class->new( @$args ) : $class->new;
    return( $obj );
}

# NOTE: THAW is called by Sereal and CBOR
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 );
    $ref = ( CORE::scalar( @$ref ) && CORE::ref( $ref->[0] ) eq 'ARRAY' ) ? $ref->[0] : [];
    my $new;
    if( $THAW_REOPENS_FILE && CORE::defined( $ref ) && CORE::ref( $ref ) eq 'ARRAY' )
    {
        $new = $class->new( @$ref );
    }
    else
    {
        $new = $class->new;
    }
    CORE::return( $new );
}

1;
# NOTE: POD
__END__

=encoding utf-8

=head1 NAME

Module::Generic::File::IO - File IO Object Wrapper

=head1 SYNOPSIS

    use Module::Generic::File::IO;
    my $io = Module::Generic::File::IO->new || 
        die( Module::Generic::File::IO->error, "\n" );
    my $io = Module::Generic::File::IO->new( fileno => $fileno ) || 
        die( Module::Generic::File::IO->error, "\n" );

    use Module::Generic::File::IO qw( wraphandle );
    my $io = wraphandle( $fh );
    my $io = wraphandle( $fh, '>' );

=head1 VERSION