DBIx-Custom / t / sqlite.t /
Newer Older
423 lines | 12.013kb
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
### a little complex test
cleanup test
Yuki Kimoto authored on 2011-08-06
182

            
test cleanup
Yuki Kimoto authored on 2011-08-10
183
test 'Model class';
184
use MyDBI1;
185
$dbi = MyDBI1->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
186
eval { $dbi->execute('drop table table1') };
187
$dbi->execute($create_table1);
188
$model = $dbi->model('table1');
189
$model->insert({key1 => 'a', key2 => 'b'});
190
is_deeply($model->list->all, [{key1 => 'a', key2 => 'b'}], 'basic');
191
eval { $dbi->execute('drop table table2') };
192
$dbi->execute($create_table2);
193
$model = $dbi->model('table2');
194
$model->insert({key1 => 'a'});
195
is_deeply($model->list->all, [{key1 => 'a', key3 => undef}], 'basic');
196
is($dbi->models->{'table1'}, $dbi->model('table1'));
197
is($dbi->models->{'table2'}, $dbi->model('table2'));
test cleanup
Yuki Kimoto authored on 2011-08-10
198

            
199
$dbi = MyDBI4->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
200
eval { $dbi->execute('drop table table1') };
201
$dbi->execute($create_table1);
202
$model = $dbi->model('table1');
203
$model->insert({key1 => 'a', key2 => 'b'});
204
is_deeply($model->list->all, [{key1 => 'a', key2 => 'b'}], 'basic');
205
$dbi->execute($create_table2);
206
$model = $dbi->model('table2');
207
$model->insert({key1 => 'a'});
208
is_deeply($model->list->all, [{key1 => 'a', key3 => undef}], 'basic');
test cleanup
Yuki Kimoto authored on 2011-08-10
209

            
test cleanup
Yuki Kimoto authored on 2011-08-10
210
$dbi = MyDBI5->connect;
211
eval { $dbi->execute('drop table table1') };
cleanup test
Yuki Kimoto authored on 2011-08-10
212
eval { $dbi->execute('drop table table2') };
213
$dbi->execute($create_table1);
214
$dbi->execute($create_table2);
215
$model = $dbi->model('table2');
216
$model->insert({key1 => 'a'});
217
is_deeply($model->list->all, [{key1 => 'a', key3 => undef}], 'include all model');
test cleanup
Yuki Kimoto authored on 2011-08-10
218
$dbi->insert(table => 'table1', param => {key1 => 1});
cleanup test
Yuki Kimoto authored on 2011-08-10
219
$model = $dbi->model('table1');
220
is_deeply($model->list->all, [{key1 => 1, key2 => undef}], 'include all model');
test cleanup
Yuki Kimoto authored on 2011-08-10
221

            
test cleanup
Yuki Kimoto authored on 2011-08-10
222
test 'primary_key';
223
use MyDBI1;
224
$dbi = MyDBI1->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
225
$model = $dbi->model('table1');
226
$model->primary_key(['key1', 'key2']);
227
is_deeply($model->primary_key, ['key1', 'key2']);
test cleanup
Yuki Kimoto authored on 2011-08-10
228

            
test cleanup
Yuki Kimoto authored on 2011-08-10
229
test 'columns';
230
use MyDBI1;
231
$dbi = MyDBI1->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
232
$model = $dbi->model('table1');
233
$model->columns(['key1', 'key2']);
234
is_deeply($model->columns, ['key1', 'key2']);
test cleanup
Yuki Kimoto authored on 2011-08-10
235

            
test cleanup
Yuki Kimoto authored on 2011-08-10
236
test 'setup_model';
237
use MyDBI1;
238
$dbi = MyDBI1->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
239
eval { $dbi->execute('drop table table1') };
240
eval { $dbi->execute('drop table table2') };
test cleanup
Yuki Kimoto authored on 2011-08-10
241

            
cleanup test
Yuki Kimoto authored on 2011-08-10
242
$dbi->execute($create_table1);
243
$dbi->execute($create_table2);
test cleanup
Yuki Kimoto authored on 2011-08-10
244
$dbi->setup_model;
cleanup test
Yuki Kimoto authored on 2011-08-10
245
is_deeply($dbi->model('table1')->columns, ['key1', 'key2']);
246
is_deeply($dbi->model('table2')->columns, ['key1', 'key3']);
test cleanup
Yuki Kimoto authored on 2011-08-10
247

            
248

            
test cleanup
Yuki Kimoto authored on 2011-08-10
249
### SQLite only test
250
test 'prefix';
251
$dbi = DBIx::Custom->connect;
252
eval { $dbi->execute('drop table table1') };
253
$dbi->execute('create table table1 (key1 varchar, key2 varchar, primary key(key1));');
254
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
255
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 4}, prefix => 'or replace');
256
$result = $dbi->execute('select * from table1;');
257
$rows   = $result->all;
258
is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
test cleanup
Yuki Kimoto authored on 2011-08-10
259

            
test cleanup
Yuki Kimoto authored on 2011-08-10
260
$dbi = DBIx::Custom->connect;
261
eval { $dbi->execute('drop table table1') };
262
$dbi->execute('create table table1 (key1 varchar, key2 varchar, primary key(key1));');
263
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
264
$dbi->update(table => 'table1', param => {key2 => 4},
265
  where => {key1 => 1}, prefix => 'or replace');
266
$result = $dbi->execute('select * from table1;');
267
$rows   = $result->all;
268
is_deeply($rows, [{key1 => 1, key2 => 4}], "basic");
test cleanup
Yuki Kimoto authored on 2011-08-10
269

            
270

            
test cleanup
Yuki Kimoto authored on 2011-08-10
271
test 'quote';
272
$dbi = DBIx::Custom->connect;
273
$dbi->quote('"');
274
eval { $dbi->execute("drop table ${q}table$p") };
275
$dbi->execute($create_table_reserved);
276
$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
277
$dbi->insert(table => 'table', param => {select => 1});
278
$dbi->delete(table => 'table', where => {select => 1});
279
$result = $dbi->execute("select * from ${q}table$p");
280
$rows   = $result->all;
281
is_deeply($rows, [], "reserved word");
282

            
test cleanup
Yuki Kimoto authored on 2011-08-10
283
test 'finish statement handle';
284
$dbi = DBIx::Custom->connect;
285
$dbi->execute($create_table1);
286
$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
287
$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
288

            
289
$result = $dbi->select(table => 'table1');
290
$row = $result->fetch_first;
291
is_deeply($row, [1, 2], "row");
292
$row = $result->fetch;
293
ok(!$row, "finished");
294

            
295
$result = $dbi->select(table => 'table1');
296
$row = $result->fetch_hash_first;
297
is_deeply($row, {key1 => 1, key2 => 2}, "row");
298
$row = $result->fetch_hash;
299
ok(!$row, "finished");
300

            
301
$dbi->execute('create table table2 (key1, key2);');
302
$result = $dbi->select(table => 'table2');
303
$row = $result->fetch_hash_first;
304
ok(!$row, "no row fetch");
305

            
306
$dbi = DBIx::Custom->connect;
307
eval { $dbi->execute('drop table table1') };
308
$dbi->execute($create_table1);
309
$dbi->insert({key1 => 1, key2 => 2}, table => 'table1');
310
$dbi->insert({key1 => 3, key2 => 4}, table => 'table1');
311
$dbi->insert({key1 => 5, key2 => 6}, table => 'table1');
312
$dbi->insert({key1 => 7, key2 => 8}, table => 'table1');
313
$dbi->insert({key1 => 9, key2 => 10}, table => 'table1');
314
$result = $dbi->select(table => 'table1');
315
$rows = $result->fetch_multi(2);
316
is_deeply($rows, [[1, 2],
317
                  [3, 4]], "fetch_multi first");
318
$rows = $result->fetch_multi(2);
319
is_deeply($rows, [[5, 6],
320
                  [7, 8]], "fetch_multi secound");
321
$rows = $result->fetch_multi(2);
322
is_deeply($rows, [[9, 10]], "fetch_multi third");
323
$rows = $result->fetch_multi(2);
324
ok(!$rows);
325

            
326
$result = $dbi->select(table => 'table1');
327
eval {$result->fetch_multi};
328
like($@, qr/Row count must be specified/, "Not specified row count");
329

            
330
$result = $dbi->select(table => 'table1');
331
$rows = $result->fetch_hash_multi(2);
332
is_deeply($rows, [{key1 => 1, key2 => 2},
333
                  {key1 => 3, key2 => 4}], "fetch_multi first");
334
$rows = $result->fetch_hash_multi(2);
335
is_deeply($rows, [{key1 => 5, key2 => 6},
336
                  {key1 => 7, key2 => 8}], "fetch_multi secound");
337
$rows = $result->fetch_hash_multi(2);
338
is_deeply($rows, [{key1 => 9, key2 => 10}], "fetch_multi third");
339
$rows = $result->fetch_hash_multi(2);
340
ok(!$rows);
341

            
342
$result = $dbi->select(table => 'table1');
343
eval {$result->fetch_hash_multi};
344
like($@, qr/Row count must be specified/, "Not specified row count");
345

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

            
cleanup test
Yuki Kimoto authored on 2011-08-10
347
test 'type option'; # DEPRECATED!
348
$dbi = DBIx::Custom->connect(
349
    data_source => 'dbi:SQLite:dbname=:memory:',
350
    dbi_option => {
351
        $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1)
352
    }
353
);
354
$binary = pack("I3", 1, 2, 3);
355
eval { $dbi->execute('drop table table1') };
356
$dbi->execute('create table table1(key1, key2)');
357
$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [key1 => DBI::SQL_BLOB]);
358
$result = $dbi->select(table => 'table1');
359
$row   = $result->one;
360
is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
361
$result = $dbi->execute('select length(key1) as key1_length from table1');
362
$row = $result->one;
363
is($row->{key1_length}, length $binary);
364

            
365
test 'type_rule from';
366
$dbi = DBIx::Custom->connect;
367
$dbi->type_rule(
368
    from1 => {
369
        date => sub { uc $_[0] }
370
    }
371
);
372
$dbi->execute("create table table1 (key1 Date, key2 datetime)");
373
$dbi->insert({key1 => 'a'}, table => 'table1');
374
$result = $dbi->select(table => 'table1');
375
is($result->fetch_first->[0], 'A');
376

            
377
$result = $dbi->select(table => 'table1');
378
is($result->one->{key1}, 'A');
379

            
test cleanup
Yuki Kimoto authored on 2011-08-10
380
# DEPRECATED! test
381
test 'filter __ expression';
382
$dbi = DBIx::Custom->connect;
cleanup test
Yuki Kimoto authored on 2011-08-10
383
eval { $dbi->execute('drop table table2') };
384
eval { $dbi->execute('drop table table3') };
385
$dbi->execute('create table table2 (id, name, table3_id)');
386
$dbi->execute('create table table3 (id, name)');
387
$dbi->apply_filter('table3',
test cleanup
Yuki Kimoto authored on 2011-08-10
388
  name => {in => sub { uc $_[0] } }
389
);
390

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

            
394
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
395
    table => ['table2', 'table3'], relation => {'table2.table3_id' => 'table3.id'},
396
    column => ['table3.name as table3__name']
test cleanup
Yuki Kimoto authored on 2011-08-10
397
);
398
is($result->fetch_first->[0], 'B');
399

            
400
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
401
    table => 'table2', relation => {'table2.table3_id' => 'table3.id'},
402
    column => ['table3.name as table3__name']
test cleanup
Yuki Kimoto authored on 2011-08-10
403
);
404
is($result->fetch_first->[0], 'B');
405

            
406
$result = $dbi->select(
cleanup test
Yuki Kimoto authored on 2011-08-10
407
    table => 'table2', relation => {'table2.table3_id' => 'table3.id'},
408
    column => ['table3.name as "table3.name"']
test cleanup
Yuki Kimoto authored on 2011-08-10
409
);
410
is($result->fetch_first->[0], 'B');
test cleanup
Yuki Kimoto authored on 2011-08-10
411

            
412
test 'reserved_word_quote';
413
$dbi = DBIx::Custom->connect;
414
eval { $dbi->execute("drop table ${q}table$p") };
415
$dbi->reserved_word_quote('"');
416
$dbi->execute($create_table_reserved);
417
$dbi->apply_filter('table', select => {out => sub { $_[0] * 2}});
418
$dbi->apply_filter('table', update => {out => sub { $_[0] * 3}});
419
$dbi->insert(table => 'table', param => {select => 1});
420
$dbi->update(table => 'table', where => {'table.select' => 1}, param => {update => 2});
421
$result = $dbi->execute("select * from ${q}table$p");
422
$rows   = $result->all;
423
is_deeply($rows, [{select => 2, update => 6}], "reserved word");