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