Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

How to serialize and deserialize Dios/Object::InsideOut objects?

by clueless newbie (Deacon)
on May 23, 2019 at 18:51 UTC ( #11100432=perlquestion: print w/replies, xml ) Need Help??

clueless newbie has asked for the wisdom of the Perl Monks concerning the following question:

Ave!

I'm struggling with serializing and deserializing Dios/Object::InsideOut objects. So far as I can tell Dios makes use of Object::InsideOut and Object::InsideOut provides $object->dump() and Object::InsideOut->pump() for serialization/deserialization. On an object that does NOT contain another object I've been able to get it to work but when the object contains other objects as in the code below nothing I've tried works?

#!/usr/bin/env perl use Data::Dumper; use Data::Dx; use Dios { accessors => 'unified' }; use Getopt::Long; use Path::Tiny; use Test::Expr; use 5.014_00; class Nada { has Int $.number is rw; }; class Yada { has Int $.number is rw; has Nada @.nadas is rw; }; # class Yada: BEGIN { # Let's confirm that Dios uses Object::InsideOut so we can "dump" +and "pump" say $INC{'Object/InsideOut.pm'}; }; Getopt::Long::GetOptions( "initialize" => \my $initialize, "restore" => \my $restore, "save" => \my $save, ); say "<co de>"; Nada->new(), Yada->new(), say "initialized!" if ($initialize); sub test_our_yada { my $self=shift; ok $self->isa('Yada'); ok $self->number() == 0; ok @{$self->nadas()} == 2; Dx $self->nadas(); ok $self->nadas()->[0]->number() == 1; ok $self->nadas()->[1]->number() == 2; } if ($save) { # The "initial" Yada my $yada=Yada->new(number=>0,nadas=>[Nada->new(number=>1),Nada->ne +w(number=>2)]); $yada->main::test_our_yada(); # $erialized and written to 'Yada.dat' Path::Tiny::path('Yada.dat')->spew_raw($yada->dump(1)); done_testing; } elsif ($restore) { # The restored from 'Yada.dat' Yada my $yada=Object::InsideOut->pump(Path::Tiny::path('Yada.dat')->slu +rp_raw()); $yada->main::test_our_yada(); done_testing; } else { warn "Needs a 'save' or a 'restore'."; } say "</co de>"; __END__
My results can be seen
# Saved WITHOUT initial "Nada->new(), Yada->new()" >perl test_01.t -save ok 1 - $self->isa('Yada') ok 2 - $self->number() == 0 ok 3 - @{$self->nadas()} == 2 #line 38 test_01.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] ok 4 - $self->nadas()->[0]->number() == 1 ok 5 - $self->nadas()->[1]->number() == 2 1..5 # Restored WITHOUT initial "Nada->new(), Yada->new()" >perl test_01.t -restore OIO::Args error: Unknown field name for class 'Yada': number Package: main File: test_01.t Line: 52 Trace begun at test_01.t line 52 # Restored WITH initial "Nada->new(), Yada->new()" >perl test_01.t -initialize -restore initialized! ok 1 - $self->isa('Yada') ok 2 - $self->number() == 0 ok 3 - @{$self->nadas()} == 2 #line 38 test_01.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] not ok 4 - $self->nadas()->[0]->number() == 1 # Failed test '$self->nadas()->[0]->number() == 1' # at test_01.t line 45. # # (do{$self->nadas()->[0]->number() == 1}) was false # because: # $self --> bless(do{\(my $o = 1)}, "Yada") # not ok 5 - $self->nadas()->[1]->number() == 2 # Failed test '$self->nadas()->[1]->number() == 2' # at test_01.t line 46. # # (do{$self->nadas()->[1]->number() == 2}) was false # because: # $self --> bless(do{\(my $o = 1)}, "Yada") # 1..5 ERROR: Duplicate reclaimed object ID (1) in class tree for Nada in thr +ead 0 # Looks like you failed 2 tests of 5. # Saved WITH initial "Nada->new(), Yada->new()" >perl test_01.t -initialize -save initialized! ok 1 - $self->isa('Yada') ok 2 - $self->number() == 0 ok 3 - @{$self->nadas()} == 2 #line 38 test_01.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] ok 4 - $self->nadas()->[0]->number() == 1 ok 5 - $self->nadas()->[1]->number() == 2 1..5 # Restored WITHOUT initial "Nada->new(), Yada->new()" >perl test_01.t -restore OIO::Args error: Unknown field name for class 'Yada': number Package: main File: test_01.t Line: 52 Trace begun at test_01.t line 52 # Restored WITH initial "Nada->new(), Yada->new()" >perl test_01.t -initialize -restore initialized! ok 1 - $self->isa('Yada') ok 2 - $self->number() == 0 ok 3 - @{$self->nadas()} == 2 #line 38 test_01.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] not ok 4 - $self->nadas()->[0]->number() == 1 # Failed test '$self->nadas()->[0]->number() == 1' # at test_01.t line 45. # # (do{$self->nadas()->[0]->number() == 1}) was false # because: # $self --> bless(do{\(my $o = 1)}, "Yada") # not ok 5 - $self->nadas()->[1]->number() == 2 # Failed test '$self->nadas()->[1]->number() == 2' # at test_01.t line 46. # # (do{$self->nadas()->[1]->number() == 2}) was false # because: # $self --> bless(do{\(my $o = 1)}, "Yada") # 1..5 ERROR: Duplicate reclaimed object ID (1) in class tree for Nada in thr +ead 0 # Looks like you failed 2 tests of 5.

What am I doing wrong - and how do I fix it?

Replies are listed 'Best First'.
Re: How to serialize and deserialize Dios/Object::InsideOut objects?
by clueless newbie (Deacon) on May 24, 2019 at 14:04 UTC

    The following appears to work correctly!

    #!/usr/bin/env perl use Data::Dx; use Dios { accessors => 'unified' }; use Storable; use Test::Expr; #use strict; # made redundant by use 5.014_00 #use warnings; # made redundant by use 5.014_00 <== +======= INCORRECT see post below! use 5.014_00; class Nada { has Int $.number is rw; }; class Yada { has Int $.number is rw; has Nada @.nadas is rw; }; # class Yada: sub test_our_yada { my $self=shift; ok $self->isa('Yada'); ok $self->number() == 0; ok @{$self->nadas()} == 2; Dx $self->nadas(); ok $self->nadas()->[0]->number() == 1; ok $self->nadas()->[1]->number() == 2; } { # The "initial" Yada my $yada=Yada->new(number=>0,nadas=>[Nada->new(number=>1),Nada->ne +w(number=>2)]); $yada->main::test_our_yada(); # Serialize $yada and write it to 'Yada.dat' my $dump=$yada->dump(); # NB: Without an argument! store($dump,'Yada.dat'); } { # The restored from 'Yada.dat' Yada object my $dump=retrieve('Yada.dat'); my $yada=Object::InsideOut->pump($dump); $yada->main::test_our_yada(); } done_testing;

    Which yields

    ok 1 - $self->isa('Yada') ok 2 - $self->number() == 0 ok 3 - @{$self->nadas()} == 2 #line 25 test_03.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] ok 4 - $self->nadas()->[0]->number() == 1 ok 5 - $self->nadas()->[1]->number() == 2 ok 6 - $self->isa('Yada') ok 7 - $self->number() == 0 ok 8 - @{$self->nadas()} == 2 #line 25 test_03.t $self->nadas() = [ bless(do{\(my $o = 1)}, "Nada"), bless(do{\(my $o = 2)}, "Nada"), ] ok 9 - $self->nadas()->[0]->number() == 1 ok 10 - $self->nadas()->[1]->number() == 2 1..10

    Somewhat simpler is

    #!/usr/bin/env perl use Data::Dx; use Dios { accessors => 'unified' }; use Storable; use Test::Expr; use 5.014_00; BEGIN { # Must go before the classes are declared! $Nada::storable=1; $Yada::storable=1; } class Nada { has Int $.number is rw; }; class Yada { has Int $.number is rw; has Nada @.nadas is rw; }; # class Yada: # Yeah, I'm lazy sub Yada::test_our_yada { my $self=shift; ok $self->isa('Yada'); ok $self->number() == 0; ok @{$self->nadas()} == 2; Dx $self->nadas(); ok $self->nadas()->[0]->number() == 1; ok $self->nadas()->[1]->number() == 2; } { # The "initial" Yada my $yada=Yada->new(number=>0,nadas=>[Nada->new(number=>1),Nada->ne +w(number=>2)]); $yada->test_our_yada(); # Serialize and write to 'Yada.dat' $yada->store('Yada.dat'); } { # Yada as restored from 'Yada.dat' my $yada=retrieve('Yada.dat'); $yada->test_our_yada(); } done_testing;

    Yabba Dabba Doo!

      Hello clueless newbie,

      Glad you found a solution. I just want to comment on this:

      #use strict; # made redundant by use 5.014_00 #use warnings; # made redundant by use 5.014_00

      The first comment is correct; but the second most certainly is not!

      From use:

      use VERSION also lexically enables all features available in the requested version as defined by the feature pragma, disabling any features not in the requested version's feature bundle.... Similarly, if the specified Perl version is greater than or equal to 5.12.0, strictures are enabled lexically as with use strict.

      (See feature#FEATURE-BUNDLES for a list of the features associated with each Perl version.) The warnings pragma must be enabled explicitly — either via the lexical use warnings;, which is the preferred method; or via a -w command line switch; or by setting the global $^W variable to a true value (not usually recommended).

      Hope that helps,

      Athanasius <°(((><contra mundum Iustus alius egestas vitae, eros Piratica,

        Living up to my username. I stand corrected!

        Thank you!

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://11100432]
Approved by Fletch
Front-paged by haukex
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others lurking in the Monastery: (3)
As of 2019-12-14 05:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?