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); |
42168332 |
9 | use Scalar::Util qw/refaddr/; |
0e08abb2 |
10 | use Carp; |
42168332 |
11 | |
12 | sub ref_ne { |
0e08abb2 |
13 | my ($refa, $refb) = map { refaddr $_ or croak "$_ is not a reference!" } @_[0,1]; |
42168332 |
14 | cmp_ok ( |
15 | $refa, |
16 | '!=', |
17 | $refb, |
18 | sprintf ('%s (0x%07x != 0x%07x)', |
19 | $_[2], |
20 | $refa, |
21 | $refb, |
22 | ), |
23 | ); |
24 | } |
69ac22ee |
25 | |
42168332 |
26 | my $schema = DBICTest->init_schema; |
69ac22ee |
27 | |
e60dc79f |
28 | my %stores = ( |
3a81f59b |
29 | dclone_method => sub { return $schema->dclone($_[0]) }, |
42168332 |
30 | dclone_func => sub { |
31 | local $DBIx::Class::ResultSourceHandle::thaw_schema = $schema; |
32 | return dclone($_[0]) |
7244b45f |
33 | }, |
42168332 |
34 | "freeze/thaw_method" => sub { |
35 | my $ice = $schema->freeze($_[0]); |
36 | return $schema->thaw($ice); |
3a81f59b |
37 | }, |
26148d36 |
38 | "nfreeze/thaw_func" => sub { |
42168332 |
39 | my $ice = freeze($_[0]); |
40 | local $DBIx::Class::ResultSourceHandle::thaw_schema = $schema; |
41 | return thaw($ice); |
26148d36 |
42 | }, |
69ac22ee |
43 | |
42168332 |
44 | "freeze/thaw_func (cdbi legacy)" => sub { |
45 | # this one is special-cased to leak the $schema all over |
46 | # the same way as cdbi-compat does |
47 | DBICTest::Artist->result_source_instance->schema($schema); |
48 | DBICTest::CD->result_source_instance->schema($schema); |
49 | |
50 | my $fire = thaw(freeze($_[0])); |
51 | |
52 | # clean up the mess |
53 | $_->result_source_instance->schema(undef) |
54 | for map { $schema->class ($_) } $schema->sources; |
55 | |
56 | return $fire; |
57 | }, |
58 | |
42168332 |
59 | ); |
69ac22ee |
60 | |
49b3a264 |
61 | if ($ENV{DBICTEST_MEMCACHED}) { |
62 | if (DBIx::Class::Optional::Dependencies->req_ok_for ('test_memcached')) { |
63 | my $memcached = Cache::Memcached->new( |
64 | { servers => [ $ENV{DBICTEST_MEMCACHED} ] } |
65 | ); |
66 | |
67 | my $key = 'tmp_dbic_84serialize_memcached_test'; |
68 | |
69 | $stores{memcached} = sub { |
0e08abb2 |
70 | $memcached->set( $key, $_[0], 60 ) |
71 | or die "Unable to insert into $ENV{DBICTEST_MEMCACHED} - is server running?"; |
49b3a264 |
72 | local $DBIx::Class::ResultSourceHandle::thaw_schema = $schema; |
73 | return $memcached->get($key); |
74 | }; |
75 | } |
76 | else { |
77 | SKIP: { |
78 | skip 'Memcached tests need ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_memcached'), 1; |
79 | } |
80 | } |
81 | } |
82 | else { |
83 | SKIP: { |
84 | skip 'Set $ENV{DBICTEST_MEMCACHED} to run the memcached serialization tests', 1; |
85 | } |
86 | } |
87 | |
88 | |
89 | |
e60dc79f |
90 | for my $name (keys %stores) { |
42168332 |
91 | |
e60dc79f |
92 | my $store = $stores{$name}; |
7d7d6975 |
93 | my $copy; |
e60dc79f |
94 | |
95 | my $artist = $schema->resultset('Artist')->find(1); |
26148d36 |
96 | |
7d7d6975 |
97 | lives_ok { $copy = $store->($artist) } "serialize row object lives: $name"; |
42168332 |
98 | ref_ne($copy, $artist, 'Simple row cloned'); |
e60dc79f |
99 | is_deeply($copy, $artist, "serialize row object works: $name"); |
100 | |
7d7d6975 |
101 | my $cd_rs = $artist->search_related("cds"); |
102 | |
0b66414b |
103 | # test that a live result source can be serialized as well |
104 | is( $cd_rs->count, 3, '3 CDs in database'); |
105 | ok( $cd_rs->next, 'Advance cursor' ); |
3a81f59b |
106 | |
7d7d6975 |
107 | lives_ok { |
108 | $copy = $store->($cd_rs); |
42168332 |
109 | |
110 | ref_ne($copy, $artist, 'Simple row cloned'); |
111 | |
7d7d6975 |
112 | is_deeply ( |
113 | [ $copy->all ], |
114 | [ $cd_rs->all ], |
115 | "serialize resultset works: $name", |
116 | ); |
117 | } "serialize resultset lives: $name"; |
118 | |
119 | # Test that an object with a related_resultset can be serialized. |
e60dc79f |
120 | ok $artist->{related_resultsets}, 'has key: related_resultsets'; |
121 | |
7d7d6975 |
122 | lives_ok { $copy = $store->($artist) } "serialize row object with related_resultset lives: $name"; |
e60dc79f |
123 | for my $key (keys %$artist) { |
124 | next if $key eq 'related_resultsets'; |
125 | next if $key eq '_inflated_column'; |
42168332 |
126 | |
127 | ref_ne($copy->{$key}, $artist->{$key}, "Simple row internals cloned '$key'") |
128 | if ref $artist->{$key}; |
129 | |
e60dc79f |
130 | is_deeply($copy->{$key}, $artist->{$key}, |
42168332 |
131 | qq[serialize with related_resultset '$key']); |
e60dc79f |
132 | } |
7d7d6975 |
133 | |
0b66414b |
134 | lives_ok( |
135 | sub { $copy->discard_changes }, "Discard changes works: $name" |
136 | ) or diag $@; |
c65da661 |
137 | is($copy->id, $artist->id, "IDs still match "); |
0b66414b |
138 | |
139 | |
140 | # Test resultsource with cached rows |
49eeb48d |
141 | $schema->is_executed_querycount( sub { |
142 | $cd_rs = $cd_rs->search ({}, { cache => 1 }); |
0b66414b |
143 | |
49eeb48d |
144 | # this will hit the database once and prime the cache |
145 | my @cds = $cd_rs->all; |
0b66414b |
146 | |
0b66414b |
147 | $copy = $store->($cd_rs); |
42168332 |
148 | ref_ne($copy, $cd_rs, 'Cached resultset cloned'); |
0b66414b |
149 | is_deeply ( |
150 | [ $copy->all ], |
151 | [ $cd_rs->all ], |
152 | "serialize cached resultset works: $name", |
153 | ); |
154 | |
155 | is ($copy->count, $cd_rs->count, 'Cached count identical'); |
49eeb48d |
156 | }, 1, 'Only one db query fired'); |
e60dc79f |
157 | } |
42168332 |
158 | |
4376a157 |
159 | # test schema-less detached thaw |
160 | { |
161 | my $artist = $schema->resultset('Artist')->find(1); |
162 | |
163 | $artist = dclone $artist; |
164 | |
165 | is( $artist->name, 'Caterwauler McCrae', 'getting column works' ); |
166 | |
167 | ok( $artist->update, 'Non-dirty update noop' ); |
168 | |
169 | ok( $artist->name( 'Beeeeeeees' ), 'setting works' ); |
170 | |
171 | ok( $artist->is_column_changed( 'name' ), 'Column dirtyness works' ); |
172 | ok( $artist->is_changed, 'object dirtyness works' ); |
173 | |
174 | my $rs = $artist->result_source->resultset; |
175 | $rs->set_cache([ $artist ]); |
176 | |
177 | is( $rs->count, 1, 'Synthetic resultset count works' ); |
178 | |
179 | my $exc = qr/Unable to perform storage-dependent operations with a detached result source.+use \$schema->thaw/; |
180 | |
181 | throws_ok { $artist->update } |
182 | $exc, |
183 | 'Correct exception on row op' |
184 | ; |
185 | |
186 | throws_ok { $artist->discard_changes } |
187 | $exc, |
188 | 'Correct exception on row op' |
189 | ; |
190 | |
191 | throws_ok { $rs->find(1) } |
192 | $exc, |
193 | 'Correct exception on rs op' |
194 | ; |
195 | } |
196 | |
42168332 |
197 | done_testing; |