Another candidate for somethingawful.com (fix left join-ed count)
[dbsrgits/DBIx-Class-Historic.git] / t / 84serialize.t
CommitLineData
70350518 1use strict;
2use warnings;
3
4use Test::More;
7d7d6975 5use Test::Exception;
70350518 6use lib qw(t/lib);
7use DBICTest;
e60dc79f 8use Storable qw(dclone freeze thaw);
69ac22ee 9
a47e1233 10my $schema = DBICTest->init_schema();
69ac22ee 11
e60dc79f 12my %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 24plan tests => (11 * keys %stores);
69ac22ee 25
e60dc79f 26for 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}