Commit | Line | Data |
70350518 |
1 | use strict; |
26148d36 |
2 | use warnings; |
70350518 |
3 | |
4 | use Test::More; |
7d7d6975 |
5 | use Test::Exception; |
70350518 |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
26148d36 |
8 | use Storable qw(dclone freeze nfreeze thaw); |
69ac22ee |
9 | |
a47e1233 |
10 | my $schema = DBICTest->init_schema(); |
69ac22ee |
11 | |
e60dc79f |
12 | my %stores = ( |
3a81f59b |
13 | dclone_method => sub { return $schema->dclone($_[0]) }, |
14 | dclone_func => sub { return dclone($_[0]) }, |
15 | "freeze/thaw_method" => sub { |
7244b45f |
16 | my $ice = $schema->freeze($_[0]); |
17 | return $schema->thaw($ice); |
18 | }, |
3a81f59b |
19 | "freeze/thaw_func" => sub { |
20 | thaw(freeze($_[0])); |
21 | }, |
26148d36 |
22 | "nfreeze/thaw_func" => sub { |
23 | thaw(nfreeze($_[0])); |
24 | }, |
e60dc79f |
25 | ); |
69ac22ee |
26 | |
7d7d6975 |
27 | plan tests => (11 * keys %stores); |
69ac22ee |
28 | |
e60dc79f |
29 | for my $name (keys %stores) { |
30 | my $store = $stores{$name}; |
7d7d6975 |
31 | my $copy; |
e60dc79f |
32 | |
33 | my $artist = $schema->resultset('Artist')->find(1); |
26148d36 |
34 | |
3a81f59b |
35 | # Test that the procedural versions will work if there's a registered |
36 | # schema as with CDBICompat objects and that the methods work |
37 | # without. |
38 | if( $name =~ /func/ ) { |
39 | $artist->result_source_instance->schema($schema); |
40 | DBICTest::CD->result_source_instance->schema($schema); |
41 | } |
42 | else { |
43 | $artist->result_source_instance->schema(undef); |
44 | DBICTest::CD->result_source_instance->schema(undef); |
45 | } |
46 | |
7d7d6975 |
47 | lives_ok { $copy = $store->($artist) } "serialize row object lives: $name"; |
e60dc79f |
48 | is_deeply($copy, $artist, "serialize row object works: $name"); |
49 | |
7d7d6975 |
50 | my $cd_rs = $artist->search_related("cds"); |
51 | |
52 | # test that a result source can be serialized as well |
53 | |
54 | $cd_rs->_resolved_attrs; # this builds up the {from} attr |
3a81f59b |
55 | |
7d7d6975 |
56 | lives_ok { |
57 | $copy = $store->($cd_rs); |
58 | is_deeply ( |
59 | [ $copy->all ], |
60 | [ $cd_rs->all ], |
61 | "serialize resultset works: $name", |
62 | ); |
63 | } "serialize resultset lives: $name"; |
64 | |
65 | # Test that an object with a related_resultset can be serialized. |
e60dc79f |
66 | ok $artist->{related_resultsets}, 'has key: related_resultsets'; |
67 | |
7d7d6975 |
68 | lives_ok { $copy = $store->($artist) } "serialize row object with related_resultset lives: $name"; |
e60dc79f |
69 | for my $key (keys %$artist) { |
70 | next if $key eq 'related_resultsets'; |
71 | next if $key eq '_inflated_column'; |
72 | is_deeply($copy->{$key}, $artist->{$key}, |
73 | qq[serialize with related_resultset "$key"]); |
74 | } |
7d7d6975 |
75 | |
7244b45f |
76 | ok eval { $copy->discard_changes; 1 } or diag $@; |
c65da661 |
77 | is($copy->id, $artist->id, "IDs still match "); |
e60dc79f |
78 | } |