Add support for SQL::Statement-based DBDs
[dbsrgits/DBIx-Class.git] / t / 86ss_dbm.t
CommitLineData
ac50f57b 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6
7use lib qw(t/lib);
8use DBICTest;
9use DBIC::SqlMakerTest;
10use DBIx::Class::Optional::Dependencies ();
11
12use Path::Class;
13
14plan skip_all =>
15 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ss_dbm')
16 unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ss_dbm');
17
18my $db_dir = dir(qw/t var/, "ss_dbm-$$");
19$db_dir->mkpath unless -d $db_dir;
20
21my ($dsn, $opts) = ('dbi:DBM:', {
22 f_dir => "$db_dir",
23 f_lockfile => '.lock',
24
25 dbm_type => 'BerkeleyDB',
26 dbm_mldbm => 'Storable',
27 dbm_store_metadata => 1,
28});
29
30my $schema = DBICTest::Schema->connect($dsn, '', '', $opts);
31is ($schema->storage->sqlt_type, 'DBM', 'sqlt_type correct pre-connection');
32isa_ok($schema->storage->sql_maker, 'DBIx::Class::SQLMaker::SQLStatement');
33
34# Custom deployment
35my $dbh = $schema->storage->dbh;
36my @cmds = split /\s*\;\s*/, scalar file(qw/t lib test_deploy DBICTest-Schema-1.x-SQL-Statement.sql/)->slurp;
37$dbh->do($_) for @cmds;
38
39### S:S doesn't have any sort of AUTOINCREMENT support, so IDs will have to be generated by hand ###
40
41# test primary key handling
42my $new = $schema->resultset('Artist')->create({
43 artistid => 1,
44 name => 'foo'
45});
46ok($new->artistid, "Create worked");
47
48# test LIMIT support
49for (1..6) {
50 $schema->resultset('Artist')->create({
51 artistid => $_+1,
52 name => 'Artist '.$_,
53 });
54}
55my $it = $schema->resultset('Artist')->search( {}, {
56 rows => 3,
57 offset => 2,
58 order_by => 'artistid'
59});
60is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 7 artists
61is( $it->next->name, "Artist 2", "iterator->next ok" );
62$it->next;
63$it->next;
64is( $it->next, undef, "next past end of resultset ok" );
65
66# Limit with select-lock (which is silently thrown away)
67lives_ok {
68 isa_ok (
69 $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}),
70 'DBICTest::Schema::Artist',
71 );
72} 'Limited FOR UPDATE select works';
73
74# shared-lock (which is silently thrown away)
75lives_ok {
76 isa_ok (
77 $schema->resultset('Artist')->find({artistid => 1}, {for => 'shared'}),
78 'DBICTest::Schema::Artist',
79 );
80} 'LOCK IN SHARE MODE select works';
81
82# (No nullables with DBD::DBM)
83my $test_type_info = {
84 'artistid' => {
85 'data_type' => 'VARCHAR',
86 'is_nullable' => 0,
87 'size' => 0,
88 },
89 'name' => {
90 'data_type' => 'VARCHAR',
91 'is_nullable' => 0,
92 'size' => 100,
93 },
94 'rank' => {
95 'data_type' => 'VARCHAR',
96 'is_nullable' => 0,
97 'size' => 0,
98 },
99 'charfield' => {
100 'data_type' => 'VARCHAR',
101 'is_nullable' => 0,
102 'size' => 10,
103 },
104};
105
106$schema->populate ('Owners', [
107 [qw/id name /],
108 [qw/1 wiggle/],
109 [qw/2 woggle/],
110 [qw/3 boggle/],
111]);
112
113$schema->populate ('BooksInLibrary', [
114 [qw/id source owner title /],
115 [qw/1 Library 1 secrets1/],
116 [qw/2 Eatery 1 secrets2/],
117 [qw/3 Library 2 secrets3/],
118]);
119
120{
121 # try a ->has_many direction (due to a 'multi' accessor the select/group_by group is collapsed)
122 my $owners = $schema->resultset('Owners')->search(
123 { 'books.id' => { '!=', undef }},
124 { prefetch => 'books', cache => 1 }
125 );
126 is($owners->all, 2, 'Prefetched grouped search returns correct number of rows');
127
128 # only works here because of the full cache
129 # S:S would croak on a subselect otherwise
130 is($owners->count, 2, 'Prefetched grouped search returns correct count');
131
132 # try a ->belongs_to direction (no select collapse)
133 my $books = $schema->resultset('BooksInLibrary')->search (
134 { 'owner.name' => 'wiggle' },
135 { prefetch => 'owner', distinct => 1 }
136 );
137
138 {
139 local $TODO = 'populate does not subtract the non-Library INSERTs here...';
140 is($owners->all, 1, 'Prefetched grouped search returns correct number of rows');
141 is($owners->count, 1, 'Prefetched grouped search returns correct count');
142 }
143}
144
145my $type_info = $schema->storage->columns_info_for('artist');
146is_deeply($type_info, $test_type_info, 'columns_info_for - column data types');
147
148my $cd = $schema->resultset('CD')->create({ cdid => 1 });
149my $producer = $schema->resultset('Producer')->create({ producerid => 1 });
150lives_ok { $cd->set_producers ([ $producer ]) } 'set_relationship doesnt die';
151
152{
153 my $artist = $schema->resultset('Artist')->next;
154 my $cd = $schema->resultset('CD')->next;
155 $cd->set_from_related('artist', $artist);
156 $cd->update;
157
158 my $rs = $schema->resultset('CD')->search ({}, { prefetch => 'artist' });
159
160 lives_ok sub {
161 my $cd = $rs->next;
162 is ($cd->artist->name, $artist->name, 'Prefetched artist');
163 }, 'join does not throw';
164
165 local $schema->storage->sql_maker->{_default_jointype} = 'inner';
166 is_same_sql_bind (
167 $rs->as_query,
168 '(
169 SELECT
170 me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
171 artist.artistid, artist.name, artist.rank, artist.charfield
172 FROM cd me
173 INNER JOIN artist artist ON artist.artistid = me.artist
174 )',
175 [],
176 'overriden default join type works',
177 );
178}
179
180{
181 # Test support for straight joins
182 my $cdsrc = $schema->source('CD');
183 my $artrel_info = $cdsrc->relationship_info ('artist');
184 $cdsrc->add_relationship(
185 'straight_artist',
186 $artrel_info->{class},
187 $artrel_info->{cond},
188 { %{$artrel_info->{attrs}}, join_type => 'straight' },
189 );
190 is_same_sql_bind (
191 $cdsrc->resultset->search({}, { prefetch => 'straight_artist' })->as_query,
192 '(
193 SELECT
194 me.cdid, me.artist, me.title, me.year, me.genreid, me.single_track,
195 straight_artist.artistid, straight_artist.name, straight_artist.rank, straight_artist.charfield
196 FROM cd me
197 STRAIGHT JOIN artist straight_artist ON straight_artist.artistid = me.artist
198 )',
199 [],
200 'straight joins correctly supported'
201 );
202}
203
204# Can we properly deal with the null search problem?
205{
206 $schema->resultset('Artist')->create({ artistid => 2222, name => 'last created artist' });
207
208 ok my $artist1_rs = $schema->resultset('Artist')->search({artistid=>6666})
209 => 'Created an artist resultset of 6666';
210
211 is $artist1_rs->count, 0
212 => 'Got no returned rows';
213
214 ok my $artist2_rs = $schema->resultset('Artist')->search({artistid=>undef})
215 => 'Created an artist resultset of undef';
216
217 is $artist2_rs->count, 0
218 => 'got no rows';
219
220 my $artist = $artist2_rs->single;
221
222 is $artist => undef
223 => 'Nothing Found!';
224}
225
226{
227 my $cds_per_year = {
228 2001 => 2,
229 2002 => 1,
230 2005 => 3,
231 };
232
233 # kill the scalar ref here
234 $schema->source('CD')->name('cd');
235
236 my $rs = $schema->resultset('CD');
237 $rs->delete;
238 my $cdid = 1;
239 foreach my $y (keys %$cds_per_year) {
240 foreach my $c (1 .. $cds_per_year->{$y} ) {
241 $rs->create({ cdid => $cdid++, title => "CD $y-$c", artist => 1, year => "$y-01-01" });
242 }
243 }
244
245 is ($rs->count, 6, 'CDs created successfully');
246}
247
248done_testing;