DBIx-Custom / t / 01-core.t /
Newer Older
277 lines | 7.52kb
add test
yuki-kimoto authored on 2009-10-16
1
use Test::More 'no_plan';
2
use strict;
3
use warnings;
4

            
5
use DBI::Custom;
6
use Scalar::Util qw/blessed/;
7

            
8
# user password database
9
our ($U, $P, $D) = connect_info();
10

            
11

            
12
{
13
    my $dbi = DBI::Custom->new(
14
        connect_info => {
15
            user => 'a',
16
            password => 'b',
17
            data_source => 'c',
18
            options => {d => 1, e => 2}
19
        },
20
        filters => {
21
            f => 3,
22
        },
23
        bind_filter => 'f',
24
        fetch_filter => 'g',
25
        dbh => 'e',
add tests
yuki-kimoto authored on 2009-10-18
26
        result_class => 'g'
add test
yuki-kimoto authored on 2009-10-16
27
    );
28
    
add tests
yuki-kimoto authored on 2009-10-18
29
    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', 
30
                    options => {d => 1, e => 2}}, filters => {f => 3}, bind_filter => 'f',
31
                    fetch_filter => 'g', dbh => 'e', result_class => 'g'}, 'new');
add test
yuki-kimoto authored on 2009-10-16
32
    
33
    isa_ok($dbi, 'DBI::Custom');
34
}
35

            
36
{
37
    package DBI::Custom::T1;
38
    use base 'DBI::Custom';
39
    
40
    __PACKAGE__->initialize_model(sub {
41
        my $model = shift;
42
        
43
        $model
44
          ->connect_info(
45
            user => 'a',
46
            password => 'b',
47
            data_source => 'c',
48
            options => {d => 1, e => 2}
49
          )
50
          ->filters(
51
            f => 3
52
          )
53
          ->bind_filter('f')
54
          ->fetch_filter('g')
55
          ->dbh('e')
56
    });
57
}
58
{
59
    my $dbi = DBI::Custom::T1->new(
60
        connect_info => {
61
            user => 'ao',
62
            password => 'bo',
63
            data_source => 'co',
64
            options => {do => 10, eo => 20}
65
        },
66
        filters => {
67
            fo => 30,
68
        },
69
        bind_filter => 'fo',
70
        fetch_filter => 'go',
add tests
yuki-kimoto authored on 2009-10-18
71
        result_class => 'ho'
add test
yuki-kimoto authored on 2009-10-16
72
    );
73
    
add tests
yuki-kimoto authored on 2009-10-18
74
    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}}
75
                    ,filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new arguments');
add test
yuki-kimoto authored on 2009-10-16
76
    
77
    isa_ok($dbi, 'DBI::Custom::T1');
78
}
79

            
80
{
81
    my $dbi = DBI::Custom::T1->new;
82
    
add tests
yuki-kimoto authored on 2009-10-18
83
    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
84
                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class');
add test
yuki-kimoto authored on 2009-10-16
85
    
86
    isa_ok($dbi, 'DBI::Custom::T1');
87
    
88
}
89

            
90
{
91
    package DBI::Custom::T1_2;
92
    use base 'DBI::Custom::T1';
93
}
94

            
95
{
96
    my $dbi = DBI::Custom::T1_2->new;
97
    
add tests
yuki-kimoto authored on 2009-10-18
98
    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
99
                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', result_class => 'DBI::Custom::Result'}, 'new custom class inherit');
add test
yuki-kimoto authored on 2009-10-16
100
    
101
    isa_ok($dbi, 'DBI::Custom::T1_2');
102
}
103

            
104
{
105
    package DBI::Custom::T1_3;
106
    use base 'DBI::Custom::T1';
107
    
108
    __PACKAGE__->initialize_model(sub {
109
        my $model = shift;
110
        
111
        $model
112
          ->connect_info(
113
            user => 'ao',
114
            password => 'bo',
115
            data_source => 'co',
116
            options => {do => 10, eo => 20}
117
          )
118
          ->filters(
119
            fo => 30
120
          )
121
          ->bind_filter('fo')
122
          ->fetch_filter('go')
123
          ->dbh('eo')
add tests
yuki-kimoto authored on 2009-10-18
124
          ->result_class('ho');
125
       
add test
yuki-kimoto authored on 2009-10-16
126
    });
127
    
128
}
129

            
130
{
131
    my $dbi = DBI::Custom::T1_3->new;
132
    
add tests
yuki-kimoto authored on 2009-10-18
133
    is_deeply($dbi,{connect_info => {user => 'ao', password => 'bo', data_source => 'co', options => {do => 10, eo => 20}},
134
                    filters => {fo => 30}, bind_filter => 'fo', fetch_filter => 'go', result_class => 'ho'}, 'new custom class');
add test
yuki-kimoto authored on 2009-10-16
135
    
136
    isa_ok($dbi, 'DBI::Custom::T1_3');
137
}
138

            
139
{
140
    my $dbi = DBI::Custom::T1_3->new(
141
        connect_info => {
142
            user => 'a',
143
            password => 'b',
144
            data_source => 'c',
145
            options => {d => 1, e => 2}
146
        },
147
        filters => {
148
            f => 3,
149
        },
150
        bind_filter => 'f',
151
        fetch_filter => 'g',
152
        dbh => 'e',
add tests
yuki-kimoto authored on 2009-10-18
153
        result_class => 'h'
add test
yuki-kimoto authored on 2009-10-16
154
    );
155
    
add tests
yuki-kimoto authored on 2009-10-18
156
    is_deeply($dbi,{connect_info => {user => 'a', password => 'b', data_source => 'c', options => {d => 1, e => 2}},
157
                    filters => {f => 3}, bind_filter => 'f', fetch_filter => 'g', dbh => 'e', result_class => 'h'}, 'new');
add test
yuki-kimoto authored on 2009-10-16
158
    
159
    isa_ok($dbi, 'DBI::Custom');
160
}
161

            
162
{
163
    my $dbi = DBI::Custom->new(
164
        connect_info => {
165
            user => $U,
166
            password => $P,
167
            data_source => "dbi:mysql:$D"
168
        }
169
    );
170
    $dbi->connect;
171
    
172
    ok(blessed $dbi->dbh);
173
    can_ok($dbi->dbh, qw/prepare/);
add test
yuki-kimoto authored on 2009-10-17
174
}
175

            
176
{
177
    my $dbi = DBI::Custom->new(
178
        connect_info => {
179
            no_exist => 1,
180
        }
181
    );
182
    eval{$dbi->connect};
add test
yuki-kimoto authored on 2009-10-16
183
    
add test
yuki-kimoto authored on 2009-10-17
184
    like($@, qr/connect_info 'no_exist' is invald/, 'no exist');
add test
yuki-kimoto authored on 2009-10-16
185
}
186

            
try varioud way
yuki-kimoto authored on 2009-10-17
187
{
188
    my $dbi = DBI::Custom->new;
189
    my $tmpl   = "select * from table where {= title};";
190
    my $values = {title => 'a'};
191
    my ($sql, @bind) = $dbi->create_sql($tmpl, $values);
try various way
yuki-kimoto authored on 2009-10-17
192
    is($sql, "select * from table where title = ?;", 'sql template');
193
    is_deeply(\@bind, ['a'], 'sql template bind' );
194
}
195

            
196
{
197
    # Expand place holer
198
    my $dbi = DBI::Custom->new;
199
    my $tmpl   = "select * from table where {= k1} && {<> k2} && {< k3} && {> k4} && {>= k5} && {<= k6} && {like k7}";
200
    my $values = {k1 => 'a', k2 => 'b', k3 => 'c', k4 => 'd', k5 => 'e', k6 => 'f', k7 => 'g'};
try varioud way
yuki-kimoto authored on 2009-10-17
201
    
try various way
yuki-kimoto authored on 2009-10-17
202
    $dbi->filters(filter => sub {
203
        my ($key, $value) = @_;
204
        if ($key eq 'k1' && $value eq 'a') {
205
            return uc $value;
206
        }
207
        return $value;
208
    });
209
    
210
    my ($sql, @bind) = $dbi->create_sql($tmpl, $values, $dbi->filters->{filter});
211
    
try various way
yuki-kimoto authored on 2009-10-17
212
    is($sql, "select * from table where k1 = ? && k2 <> ? && k3 < ? && k4 > ? && k5 >= ? && k6 <= ? && k7 like ?;", 'sql template2');
try various way
yuki-kimoto authored on 2009-10-17
213
    is_deeply(\@bind, ['A', 'b', 'c', 'd', 'e', 'f', 'g'], 'sql template bind2' );
214
}
215

            
216
{
217
    # Expand place holer upper case
218
    my $dbi = DBI::Custom->new;
219
    $dbi->sql_template->upper_case(1);
220
    my $tmpl   = "select * from table where {like k7}";
221
    my $values = {k7 => 'g'};
222
    
223
    my ($sql, @bind) = $dbi->create_sql($tmpl, $values);
224
    is($sql, "select * from table where k7 LIKE ?;", 'sql template2');
225
    is_deeply(\@bind, ['g'], 'sql template bind2' );
226
}
227

            
228

            
229
{
230
    # Insert values
231
    my $dbi = DBI::Custom->new;
232
    my $tmpl   = "insert into table {insert_values}";
233
    my $values = {insert_values => {k1 => 'a', k2 => 'b'}};
234
    
235
    $dbi->filters(filter => sub {
236
        my ($key, $value) = @_;
237
        if ($key eq 'k1' && $value eq 'a') {
238
            return uc $value;
239
        }
240
        return $value;
241
    });
242
        
243
    my ($sql, @bind) = $dbi->create_sql($tmpl, $values, $dbi->filters->{filter});
244
    is($sql, "insert into table (k1, k2) values (?, ?);");
245
    is_deeply(\@bind, ['A', 'b'], 'sql template bind' );
246
}
247

            
248
{
249
    # Update set
250
    my $dbi = DBI::Custom->new;
251
    my $tmpl   = "update table {update_set}";
252
    my $values = {update_set => {k1 => 'a', k2 => 'b'}};
253

            
254
    $dbi->filters(filter => sub {
255
        my ($key, $value) = @_;
256
        if ($key eq 'k1' && $value eq 'a') {
257
            return uc $value;
258
        }
259
        return $value;
260
    });
261
        
262
    my ($sql, @bind) = $dbi->create_sql($tmpl, $values, $dbi->filters->{filter});
263
    is($sql, "update table set k1 = ?, k2 = ?;");
264
    is_deeply(\@bind, ['A', 'b'], 'sql template bind' );
try varioud way
yuki-kimoto authored on 2009-10-17
265
}
266

            
add test
yuki-kimoto authored on 2009-10-16
267
sub connect_info {
268
    my $file = 'password.tmp';
269
    open my $fh, '<', $file
270
      or return;
271
    
272
    my ($user, $password, $database) = split(/\s/, (<$fh>)[0]);
273
    
274
    close $fh;
275
    
276
    return ($user, $password, $database);
277
}