DBIx-Custom / t / sqlite.t /
Newer Older
355 lines | 9.794kb
cleanup test
Yuki Kimoto authored on 2011-08-06
1
use Test::More;
2
use strict;
3
use warnings;
4
use utf8;
5
use Encode qw/encode_utf8 decode_utf8/;
test cleanup
Yuki Kimoto authored on 2011-08-06
6
use FindBin;
cleanup test
Yuki Kimoto authored on 2011-08-10
7
use lib "$FindBin::Bin/common";
cleanup test
Yuki Kimoto authored on 2011-08-06
8

            
9
BEGIN {
10
    eval { require DBD::SQLite; 1 }
11
        or plan skip_all => 'DBD::SQLite required';
12
    eval { DBD::SQLite->VERSION >= 1.25 }
13
        or plan skip_all => 'DBD::SQLite >= 1.25 required';
14

            
15
    plan 'no_plan';
16
    use_ok('DBIx::Custom');
17
}
18

            
test cleanup
Yuki Kimoto authored on 2011-08-06
19
$SIG{__WARN__} = sub { warn $_[0] unless $_[0] =~ /DEPRECATED/};
cleanup test
Yuki Kimoto authored on 2011-08-06
20
sub test { print "# $_[0]\n" }
21

            
test cleanup
Yuki Kimoto authored on 2011-08-10
22
use DBIx::Custom;
test cleanup
Yuki Kimoto authored on 2011-08-10
23
{
24
    package DBIx::Custom;
25
    has dsn => sub { 'dbi:SQLite:dbname=:memory:' }
26
}
test cleanup
Yuki Kimoto authored on 2011-08-10
27
use MyDBI1;
28
{
29
    package MyDBI4;
30

            
31
    use strict;
32
    use warnings;
33

            
34
    use base 'DBIx::Custom';
35

            
36
    sub connect {
37
        my $self = shift->SUPER::connect(@_);
38
        
39
        $self->include_model(
40
            MyModel2 => [
cleanup test
Yuki Kimoto authored on 2011-08-10
41
                'table1',
42
                {class => 'table2', name => 'table2'}
test cleanup
Yuki Kimoto authored on 2011-08-10
43
            ]
44
        );
45
    }
46

            
47
    package MyModel2::Base1;
48

            
49
    use strict;
50
    use warnings;
51

            
52
    use base 'DBIx::Custom::Model';
53

            
cleanup test
Yuki Kimoto authored on 2011-08-10
54
    package MyModel2::table1;
test cleanup
Yuki Kimoto authored on 2011-08-10
55

            
56
    use strict;
57
    use warnings;
58

            
59
    use base 'MyModel2::Base1';
60

            
61
    sub insert {
62
        my ($self, $param) = @_;
63
        
64
        return $self->SUPER::insert(param => $param);
65
    }
66

            
67
    sub list { shift->select; }
68

            
cleanup test
Yuki Kimoto authored on 2011-08-10
69
    package MyModel2::table2;
test cleanup
Yuki Kimoto authored on 2011-08-10
70

            
71
    use strict;
72
    use warnings;
73

            
74
    use base 'MyModel2::Base1';
75

            
76
    sub insert {
77
        my ($self, $param) = @_;
78
        
79
        return $self->SUPER::insert(param => $param);
80
    }
81

            
82
    sub list { shift->select; }
83
}
84
{
85
     package MyDBI5;
86

            
87
    use strict;
88
    use warnings;
89

            
90
    use base 'DBIx::Custom';
91

            
92
    sub connect {
93
        my $self = shift->SUPER::connect(@_);
94
        
95
        $self->include_model('MyModel4');
96
    }
97
}
98
{
99
    package MyDBI6;
100
    
101
    use base 'DBIx::Custom';
102
    
103
    sub connect {
104
        my $self = shift->SUPER::connect(@_);
105
        
106
        $self->include_model('MyModel5');
107
        
108
        return $self;
109
    }
110
}
111
{
112
    package MyDBI7;
113
    
114
    use base 'DBIx::Custom';
115
    
116
    sub connect {
117
        my $self = shift->SUPER::connect(@_);
118
        
119
        $self->include_model('MyModel6');
120
        
121
        
122
        return $self;
123
    }
124
}
125
{
126
    package MyDBI8;
127
    
128
    use base 'DBIx::Custom';
129
    
130
    sub connect {
131
        my $self = shift->SUPER::connect(@_);
132
        
133
        $self->include_model('MyModel7');
134
        
135
        return $self;
136
    }
137
}
138

            
139
{
140
    package MyDBI9;
141
    
142
    use base 'DBIx::Custom';
143
    
144
    sub connect {
145
        my $self = shift->SUPER::connect(@_);
146
        
147
        $self->include_model('MyModel8')->setup_model;
148
        
149
        return $self;
150
    }
151
}
test cleanup
Yuki Kimoto authored on 2011-08-10
152

            
cleanup test
Yuki Kimoto authored on 2011-08-06
153
# Constant
cleanup test
Yuki Kimoto authored on 2011-08-10
154
my $create_table1 = 'create table table1 (key1 varchar, key2 varchar);';
155
my $create_table1_2 = 'create table table1 (key1 varchar, key2 varchar, key3 varchar, key4 varchar, key5 varchar);';
156
my $create_table2 = 'create table table2 (key1 varchar, key3 varchar);';
157
my $create_table2_2 = "create table table2 (key1 varchar, key2 varchar, key3 varchar)";
158
my $create_table3 = "create table table3 (key1 varchar, key2 varchar, key3 varchar)";
159
my $create_table_reserved = 'create table "table" ("select" varchar, "update" varchar)';
test cleanup
Yuki Kimoto authored on 2011-08-10
160

            
test cleanup
Yuki Kimoto authored on 2011-08-10
161
my $q = '"';
162
my $p = '"';
cleanup test
Yuki Kimoto authored on 2011-08-06
163

            
cleanup test
Yuki Kimoto authored on 2011-08-06
164
# Variables
165
my $dbi;
166
my $param;
167
my $params;
168
my $sql;
169
my $result;
170
my $row;
171
my @rows;
172
my $rows;
173
my $model;
174
my $model2;
175
my $where;
cleanup test
Yuki Kimoto authored on 2011-08-10
176
my $binary;
cleanup test
Yuki Kimoto authored on 2011-08-06
177

            
178
# Prepare table
test cleanup
Yuki Kimoto authored on 2011-08-10
179
$dbi = DBIx::Custom->connect;
cleanup test
Yuki Kimoto authored on 2011-08-06
180

            
test cleanup
Yuki Kimoto authored on 2011-08-10
181
### SQLite only test
182
test 'prefix';
183
$dbi = DBIx::Custom->connect;
184
eval { $dbi->execute('drop table table1') };
185
$dbi->execute('create table table1 (key1 varchar, key2 varchar, primary key(key1));');
186
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
187
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4}, prefix => 'or replace');
188
$result = $dbi->execute('select * from table1;');
189
$rows   = $result->all;
190
is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
test cleanup
Yuki Kimoto authored on 2011-08-10
191

            
test cleanup
Yuki Kimoto authored on 2011-08-10
192
$dbi = DBIx::Custom->connect;
193
eval { $dbi->execute('drop table table1') };
194
$dbi->execute('create table table1 (key1 varchar, key2 varchar, primary key(key1));');
195
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
196
$dbi->update(table => 'table1', param => {key2 => 4},
197
  where => {key1 => 1}, prefix => 'or replace');
198
$result = $dbi->execute('select * from table1;');
199
$rows   = $result->all;
200
is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
test cleanup
Yuki Kimoto authored on 2011-08-10
201

            
202

            
test cleanup
Yuki Kimoto authored on 2011-08-10
203
test 'quote';
204
$dbi = DBIx::Custom->connect;
205
$dbi->quote('"');
206
eval { $dbi->execute("drop table ${q}table$p") };
207
$dbi->execute($create_table_reserved);
208
$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
209
$dbi->insert(table => 'table', param => {select => 1});
210
$dbi->delete(table => 'table', where => {select => 1});
211
$result = $dbi->execute("select * from ${q}table$p");
212
$rows   = $result->all;
213
is_deeply($rows, [], "reserved word");
214

            
test cleanup
Yuki Kimoto authored on 2011-08-10
215
test 'finish statement handle';
216
$dbi = DBIx::Custom->connect;
217
$dbi->execute($create_table1);
218
$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
219
$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
220

            
221
$result = $dbi->select(table => 'table1');
222
$row = $result->fetch_first;
223
is_deeply($row, [1, 2], "row");
224
$row = $result->fetch;
225
ok(!$row, "finished");
226

            
227
$result = $dbi->select(table => 'table1');
228
$row = $result->fetch_hash_first;
229
is_deeply($row, {key1 => 1, key2 => 2}, "row");
230
$row = $result->fetch_hash;
231
ok(!$row, "finished");
232

            
233
$dbi->execute('create table table2 (key1, key2);');
234
$result = $dbi->select(table => 'table2');
235
$row = $result->fetch_hash_first;
236
ok(!$row, "no row fetch");
237

            
238
$dbi = DBIx::Custom->connect;
239
eval { $dbi->execute('drop table table1') };
240
$dbi->execute($create_table1);
241
$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
242
$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
243
$dbi->insert({key1 => 5, key2 => 6}, table => 'table1');
244
$dbi->insert({key1 => 7, key2 => 8}, table => 'table1');
245
$dbi->insert({key1 => 9, key2 => 10}, table => 'table1');
246
$result = $dbi->select(table => 'table1');
247
$rows = $result->fetch_multi(2);
248
is_deeply($rows, [[1, 2],
249
                  [3, 4]], "fetch_multi first");
250
$rows = $result->fetch_multi(2);
251
is_deeply($rows, [[5, 6],
252
                  [7, 8]], "fetch_multi secound");
253
$rows = $result->fetch_multi(2);
254
is_deeply($rows, [[9, 10]], "fetch_multi third");
255
$rows = $result->fetch_multi(2);
256
ok(!$rows);
257

            
258
$result = $dbi->select(table => 'table1');
259
eval {$result->fetch_multi};
260
like($@, qr/Row count must be specified/, "Not specified row count");
261

            
262
$result = $dbi->select(table => 'table1');
263
$rows = $result->fetch_hash_multi(2);
264
is_deeply($rows, [{key1 => 1, key2 => 2},
265
                  {key1 => 3, key2 => 4}], "fetch_multi first");
266
$rows = $result->fetch_hash_multi(2);
267
is_deeply($rows, [{key1 => 5, key2 => 6},
268
                  {key1 => 7, key2 => 8}], "fetch_multi secound");
269
$rows = $result->fetch_hash_multi(2);
270
is_deeply($rows, [{key1 => 9, key2 => 10}], "fetch_multi third");
271
$rows = $result->fetch_hash_multi(2);
272
ok(!$rows);
273

            
274
$result = $dbi->select(table => 'table1');
275
eval {$result->fetch_hash_multi};
276
like($@, qr/Row count must be specified/, "Not specified row count");
277

            
test cleanup
Yuki Kimoto authored on 2011-08-10
278

            
cleanup test
Yuki Kimoto authored on 2011-08-10
279
test 'type option'; # DEPRECATED!
280
$dbi = DBIx::Custom->connect(
281
    data_source => 'dbi:SQLite:dbname=:memory:',
282
    dbi_option => {
283
        $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1)
284
    }
285
);
286
$binary = pack("I3", 1, 2, 3);
287
eval { $dbi->execute('drop table table1') };
288
$dbi->execute('create table table1(key1, key2)');
289
$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [key1 => DBI::SQL_BLOB]);
290
$result = $dbi->select(table => 'table1');
291
$row   = $result->one;
292
is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
293
$result = $dbi->execute('select length(key1) as key1_length from table1');
294
$row = $result->one;
295
is($row->{key1_length}, length $binary);
296

            
297
test 'type_rule from';
298
$dbi = DBIx::Custom->connect;
299
$dbi->type_rule(
300
    from1 => {
301
        date => sub { uc $_[0] }
302
    }
303
);
304
$dbi->execute("create table table1 (key1 Date, key2 datetime)");
305
$dbi->insert({key1 => 'a'}, table => 'table1');
306
$result = $dbi->select(table => 'table1');
307
is($result->fetch_first->[0], 'A');
308

            
309
$result = $dbi->select(table => 'table1');
310
is($result->one->{key1}, 'A');
311

            
test cleanup
Yuki Kimoto authored on 2011-08-10
312
# DEPRECATED! test
313
test 'filter __ expression';
314
$dbi = DBIx::Custom->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
315
eval { $dbi->execute('drop table table2') };
316
eval { $dbi->execute('drop table table3') };
317
$dbi->execute('create table table2 (id, name, table3_id)');
318
$dbi->execute('create table table3 (id, name)');
319
$dbi->apply_filter('table3',
test cleanup
Yuki Kimoto authored on 2011-08-10
320
  name => {in => sub { uc $_[0] } }
321
);
322

            
cleanup test
Yuki Kimoto authored on 2011-08-10
323
$dbi->insert(table => 'table2', param => {id => 1, name => 'a', table3_id => 2});
324
$dbi->insert(table => 'table3', param => {id => 2, name => 'b'});
test cleanup
Yuki Kimoto authored on 2011-08-10
325

            
326
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
327
    table => ['table2', 'table3'], relation => {'table2.table3_id' => 'table3.id'},
328
    column => ['table3.name as table3__name']
test cleanup
Yuki Kimoto authored on 2011-08-10
329
);
330
is($result->fetch_first->[0], 'B');
331

            
332
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
333
    table => 'table2', relation => {'table2.table3_id' => 'table3.id'},
334
    column => ['table3.name as table3__name']
test cleanup
Yuki Kimoto authored on 2011-08-10
335
);
336
is($result->fetch_first->[0], 'B');
337

            
338
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
339
    table => 'table2', relation => {'table2.table3_id' => 'table3.id'},
340
    column => ['table3.name as "table3.name"']
test cleanup
Yuki Kimoto authored on 2011-08-10
341
);
342
is($result->fetch_first->[0], 'B');
test cleanup
Yuki Kimoto authored on 2011-08-10
343

            
344
test 'reserved_word_quote';
345
$dbi = DBIx::Custom->connect;
346
eval { $dbi->execute("drop table ${q}table$p") };
347
$dbi->reserved_word_quote('"');
348
$dbi->execute($create_table_reserved);
349
$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
350
$dbi->apply_filter('table', update => {out => sub { $_[0] * 3}});
351
$dbi->insert(table => 'table', param => {select => 1});
352
$dbi->update(table => 'table', where => {'table.select' => 1}, param => {update => 2});
353
$result = $dbi->execute("select * from ${q}table$p");
354
$rows   = $result->all;
355
is_deeply($rows, [{select => 2, update => 6}], "reserved word");