view release on metacpan or  search on metacpan

lib/Storable/Improved.pm  view on Meta::CPAN

=over 4

=item 1. You can only modify the object that is passed by L<Storable>, but L<Storable> disregards any returned value from C<STORABLE_thaw>

=item 2. The object created by L<Storable> is mostly incompatible with XS modules. For example:

    use v5.36;
    use strict;
    use warnings;
    use HTTP::XSHeaders;
    use Storable ();

    my $h = HTTP::XSHeaders->new(
        Content_Type => 'text/html; charset=utf8',
    );
    say "Content-Type: ", $h->header( 'Content-Type' );
    say "Serialising.";
    my $serial = Storable::freeze( $h );
    my $h2 = Storable::thaw( $serial );
    say "Is $h2 an object of HTTP::XSHeaders? ", ( $h2->isa( 'HTTP::XSHeaders' ) ? 'yes' : 'no' );
    say "Can $h2 do header? ", ( $h2->can( 'header' ) ? 'yes' : 'no' );
    say "Content-Type: ", $h2->header( 'Content-Type' );
    # Exception occurs here: "hl is not an instance of HTTP::XSHeaders"

would produce:

    Content-Type: text/html; charset=utf8
    Serialising.
    Is My::Headers=HASH(0x555a5c06f198) an object of HTTP::XSHeaders? yes
    Can My::Headers=HASH(0x555a5c06f198) do header? yes
    hl is not an instance of HTTP::XSHeaders

This is because, although the C<HTTP::XSHeaders> object in this example created by L<Storable> itself, is a blessed reference of L<HTTP::XSHeaders>, that object cannot successfully call its own methods! This is because that object is not a native XS ...

It would have made sense, since each module knows better than L<Storable> what needs to be done ultimately to make their object work.

=back

=head2 STORABLE_freeze_pre_processing

B<New>

If the data passed to L</freeze> is a blessed reference and that C<STORABLE_freeze_pre_processing> is implemented in the object's module, this is called by L</freeze> B<before> the object is serialised by L<Storable>, giving it a chance to make it in...

Consider the following:

    use IO::File;
    my $io = IO::File->new( __FILE__, 'r' );
    my $serial = Storable::freeze( $io );

would throw a fatal error that Storable does not accept glob, but if you did:

    use IO::File;
    local $Storable::forgive_me = 1;
    sub IO::File::STORABLE_freeze_pre_processing
    {
        my $self = shift( @_ );
        my $class = ref( $self ) || $self;
        my $args = [ __FILE__, 'r' ];
        # We change the glob object into a regular hash-based one to be Storable-friendly
        my $this = bless( { args => $args, class => $class } => $class );
        return( $this );
    }

    sub IO::File::STORABLE_thaw_post_processing
    {
        my $self = shift( @_ );
        my $args = $self->{args};
        my $class = $self->{class};
        # We restore our glob object. Geez that was hard. Not.
        my $obj = $class->new( @$args );
        return( $obj );
    }
    my $io = IO::File->new( __FILE__, 'r' );
    my $serial = Storable::Improved::freeze( $io );
    my $io2 = Storable::Improved::thaw( $serial );

And here you go, C<$io2> would be equivalent to your initial glob, opened with the same arguments as the first one.

=head2 STORABLE_thaw_post_processing

B<New>

If the data passed to L</freeze> is a blessed reference and that C<STORABLE_thaw_post_processing> is implemented in the object's module, this is called by L</thaw> B<after> L<Storable> has deserialised the data, giving you an opportunity to make fina...

Consider the following:

    use HTTP::XSHeaders;
    use Storable::Improved;
    
    sub HTTP::XSHeaders::STORABLE_freeze
    {
        my( $self, $cloning ) = @_;
        return if( $cloning );
        my $class = ref( $self ) || $self;
        my $h = {};
        my $headers = [];
        my $order = [];
        # Get all headers field and values in their original order
        $self->scan(sub
        {
            my( $f, $val ) = @_;
            if( exists( $h->{ $f } ) )
            {
                $h->{ $f } = [ $h->{ $f } ] unless( ref( $h->{ $f } ) eq 'ARRAY' );
                push( @{$h->{ $f }}, $val );
            }
            else
            {
                $h->{ $f } = $val;
                push( @$order, $f );
            }
        });
        foreach my $f ( @$order )
        {
            push( @$headers, $f, $h->{ $f } );
        }
        my %hash  = %$self;
        $hash{_headers_to_restore} = $headers;
        return( $class, \%hash );
    }