Showing 7 changed files with 666 additions and 573 deletions
+3
Changes
... ...
@@ -1,3 +1,6 @@
1
+0.1618
2
+  added helper method
3
+  added begin_work, commit, and rollback method
1 4
 0.1617
2 5
   L<DBIx::Custom> is now stable. APIs keep backword compatible in the feature.
3 6
 0.1616
+427 -391
lib/DBIx/Custom.pm
... ...
@@ -1,6 +1,6 @@
1 1
 package DBIx::Custom;
2 2
 
3
-our $VERSION = '0.1617';
3
+our $VERSION = '0.1618';
4 4
 
5 5
 use 5.008001;
6 6
 use strict;
... ...
@@ -15,19 +15,8 @@ use DBIx::Custom::Query;
15 15
 use DBIx::Custom::QueryBuilder;
16 16
 use Encode qw/encode_utf8 decode_utf8/;
17 17
 
18
-__PACKAGE__->attr('dbh');
19
-__PACKAGE__->attr([qw/user password data_source/]);
20
-__PACKAGE__->attr([qw/default_bind_filter default_fetch_filter/]);
21
-
22
-__PACKAGE__->dual_attr('filters', default => sub { {} },
23
-                                  inherit => 'hash_copy');
24
-__PACKAGE__->register_filter(
25
-    encode_utf8 => sub { encode_utf8($_[0]) },
26
-    decode_utf8 => sub { decode_utf8($_[0]) }
27
-);
28
-
29
-__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
30
-__PACKAGE__->attr(query_builder  => sub {DBIx::Custom::QueryBuilder->new});
18
+__PACKAGE__->attr([qw/data_source dbh default_bind_filter
19
+                      default_fetch_filter password user/]);
31 20
 
32 21
 __PACKAGE__->attr(cache => 1);
33 22
 __PACKAGE__->attr(cache_method => sub {
... ...
@@ -45,7 +34,30 @@ __PACKAGE__->attr(cache_method => sub {
45 34
     }
46 35
 });
47 36
 
37
+__PACKAGE__->dual_attr('filters', default => sub { {} },
38
+                                  inherit => 'hash_copy');
48 39
 __PACKAGE__->attr(filter_check => 1);
40
+__PACKAGE__->attr(query_builder  => sub {DBIx::Custom::QueryBuilder->new});
41
+__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
42
+
43
+# DBI methods
44
+foreach my $method (qw/begin_work commit rollback/) {
45
+    my $code = sub {
46
+        my $self = shift;
47
+        my $ret = eval {$self->dbh->$method};
48
+        croak $@ if $@;
49
+        return $ret;
50
+    };
51
+    no strict 'refs';
52
+    my $pkg = __PACKAGE__;
53
+    *{"${pkg}::$method"} = $code;
54
+};
55
+
56
+# Regster filter
57
+__PACKAGE__->register_filter(
58
+    encode_utf8 => sub { encode_utf8($_[0]) },
59
+    decode_utf8 => sub { decode_utf8($_[0]) }
60
+);
49 61
 
50 62
 sub connect {
51 63
     my $proto = shift;
... ...
@@ -80,70 +92,67 @@ sub connect {
80 92
     return $self;
81 93
 }
82 94
 
83
-sub register_filter {
84
-    my $invocant = shift;
95
+sub create_query {
96
+    my ($self, $source) = @_;
85 97
     
86
-    # Register filter
87
-    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
88
-    $invocant->filters({%{$invocant->filters}, %$filters});
98
+    # Cache
99
+    my $cache = $self->cache;
89 100
     
90
-    return $invocant;
91
-}
92
-
93
-our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
101
+    # Create query
102
+    my $query;
103
+    if ($cache) {
104
+        
105
+        # Get query
106
+        my $q = $self->cache_method->($self, $source);
107
+        
108
+        # Create query
109
+        $query = DBIx::Custom::Query->new($q) if $q;
110
+    }
111
+    
112
+    unless ($query) {
94 113
 
95
-sub insert {
96
-    my ($self, %args) = @_;
114
+        # Create SQL object
115
+        my $builder = $self->query_builder;
116
+        
117
+        # Create query
118
+        $query = $builder->build_query($source);
97 119
 
98
-    # Check arguments
99
-    foreach my $name (keys %args) {
100
-        croak qq{"$name" is invalid argument}
101
-          unless $VALID_INSERT_ARGS{$name};
120
+        # Cache query
121
+        $self->cache_method->($self, $source,
122
+                             {sql     => $query->sql, 
123
+                              columns => $query->columns})
124
+          if $cache;
102 125
     }
103 126
     
104
-    # Arguments
105
-    my $table  = $args{table} || '';
106
-    my $param  = $args{param} || {};
107
-    my $append = $args{append} || '';
108
-    my $filter = $args{filter};
109
-    
110
-    # Insert keys
111
-    my @insert_keys = keys %$param;
112
-    
113
-    # Templte for insert
114
-    my $source = "insert into $table {insert_param "
115
-               . join(' ', @insert_keys) . '}';
116
-    $source .= " $append" if $append;
127
+    # Prepare statement handle
128
+    my $sth;
129
+    eval { $sth = $self->dbh->prepare($query->{sql})};
130
+    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
117 131
     
118
-    # Execute query
119
-    my $ret_val = $self->execute($source, param  => $param, 
120
-                                          filter => $filter);
132
+    # Set statement handle
133
+    $query->sth($sth);
121 134
     
122
-    return $ret_val;
135
+    return $query;
123 136
 }
124 137
 
125
-our %VALID_UPDATE_ARGS
126
-  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
138
+our %VALID_DELETE_ARGS
139
+  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
127 140
 
128
-sub update {
141
+sub delete {
129 142
     my ($self, %args) = @_;
130 143
     
131 144
     # Check arguments
132 145
     foreach my $name (keys %args) {
133 146
         croak qq{"$name" is invalid argument}
134
-          unless $VALID_UPDATE_ARGS{$name};
147
+          unless $VALID_DELETE_ARGS{$name};
135 148
     }
136 149
     
137 150
     # Arguments
138 151
     my $table            = $args{table} || '';
139
-    my $param            = $args{param} || {};
140 152
     my $where            = $args{where} || {};
141
-    my $append = $args{append} || '';
153
+    my $append = $args{append};
142 154
     my $filter           = $args{filter};
143
-    my $allow_update_all = $args{allow_update_all};
144
-    
145
-    # Update keys
146
-    my @update_keys = keys %$param;
155
+    my $allow_delete_all = $args{allow_delete_all};
147 156
     
148 157
     # Where keys
149 158
     my @where_keys = keys %$where;
... ...
@@ -151,15 +160,10 @@ sub update {
151 160
     # Not exists where keys
152 161
     croak qq{"where" argument must be specified and } .
153 162
           qq{contains the pairs of column name and value}
154
-      if !@where_keys && !$allow_update_all;
155
-    
156
-    # Update clause
157
-    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
163
+      if !@where_keys && !$allow_delete_all;
158 164
     
159 165
     # Where clause
160 166
     my $where_clause = '';
161
-    my $new_where = {};
162
-    
163 167
     if (@where_keys) {
164 168
         $where_clause = 'where ';
165 169
         $where_clause .= "{= $_} and " for @where_keys;
... ...
@@ -167,79 +171,103 @@ sub update {
167 171
     }
168 172
     
169 173
     # Source of SQL
170
-    my $source = "update $table $update_clause $where_clause";
174
+    my $source = "delete from $table $where_clause";
171 175
     $source .= " $append" if $append;
172 176
     
173
-    # Rearrange parameters
174
-    foreach my $wkey (@where_keys) {
175
-        
176
-        if (exists $param->{$wkey}) {
177
-            $param->{$wkey} = [$param->{$wkey}]
178
-              unless ref $param->{$wkey} eq 'ARRAY';
179
-            
180
-            push @{$param->{$wkey}}, $where->{$wkey};
181
-        }
182
-        else {
183
-            $param->{$wkey} = $where->{$wkey};
184
-        }
185
-    }
186
-    
187 177
     # Execute query
188
-    my $ret_val = $self->execute($source, param  => $param, 
178
+    my $ret_val = $self->execute($source, param  => $where, 
189 179
                                  filter => $filter);
190 180
     
191 181
     return $ret_val;
192 182
 }
193 183
 
194
-sub update_all { shift->update(allow_update_all => 1, @_) };
184
+sub delete_all { shift->delete(allow_delete_all => 1, @_) }
195 185
 
196
-our %VALID_DELETE_ARGS
197
-  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
186
+our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
198 187
 
199
-sub delete {
200
-    my ($self, %args) = @_;
188
+sub execute{
189
+    my ($self, $query, %args)  = @_;
201 190
     
202 191
     # Check arguments
203 192
     foreach my $name (keys %args) {
204 193
         croak qq{"$name" is invalid argument}
205
-          unless $VALID_DELETE_ARGS{$name};
194
+          unless $VALID_EXECUTE_ARGS{$name};
206 195
     }
207 196
     
208
-    # Arguments
209
-    my $table            = $args{table} || '';
210
-    my $where            = $args{where} || {};
211
-    my $append = $args{append};
212
-    my $filter           = $args{filter};
213
-    my $allow_delete_all = $args{allow_delete_all};
197
+    my $params = $args{param} || {};
214 198
     
215
-    # Where keys
216
-    my @where_keys = keys %$where;
199
+    # First argument is the soruce of SQL
200
+    $query = $self->create_query($query)
201
+      unless ref $query;
217 202
     
218
-    # Not exists where keys
219
-    croak qq{"where" argument must be specified and } .
220
-          qq{contains the pairs of column name and value}
221
-      if !@where_keys && !$allow_delete_all;
203
+    my $filter = $args{filter} || $query->filter || {};
222 204
     
223
-    # Where clause
224
-    my $where_clause = '';
225
-    if (@where_keys) {
226
-        $where_clause = 'where ';
227
-        $where_clause .= "{= $_} and " for @where_keys;
228
-        $where_clause =~ s/ and $//;
205
+    # Create bind value
206
+    my $bind_values = $self->_build_bind_values($query, $params, $filter);
207
+    
208
+    # Execute
209
+    my $sth      = $query->sth;
210
+    my $affected;
211
+    eval {$affected = $sth->execute(@$bind_values)};
212
+    $self->_croak($@) if $@;
213
+    
214
+    # Return resultset if select statement is executed
215
+    if ($sth->{NUM_OF_FIELDS}) {
216
+        
217
+        # Create result
218
+        my $result = $self->result_class->new(
219
+            sth            => $sth,
220
+            default_filter => $self->default_fetch_filter,
221
+            filters        => $self->filters,
222
+            filter_check   => $self->filter_check
223
+        );
224
+
225
+        return $result;
226
+    }
227
+    return $affected;
228
+}
229
+
230
+our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
231
+
232
+sub insert {
233
+    my ($self, %args) = @_;
234
+
235
+    # Check arguments
236
+    foreach my $name (keys %args) {
237
+        croak qq{"$name" is invalid argument}
238
+          unless $VALID_INSERT_ARGS{$name};
229 239
     }
230 240
     
231
-    # Source of SQL
232
-    my $source = "delete from $table $where_clause";
241
+    # Arguments
242
+    my $table  = $args{table} || '';
243
+    my $param  = $args{param} || {};
244
+    my $append = $args{append} || '';
245
+    my $filter = $args{filter};
246
+    
247
+    # Insert keys
248
+    my @insert_keys = keys %$param;
249
+    
250
+    # Templte for insert
251
+    my $source = "insert into $table {insert_param "
252
+               . join(' ', @insert_keys) . '}';
233 253
     $source .= " $append" if $append;
234 254
     
235 255
     # Execute query
236
-    my $ret_val = $self->execute($source, param  => $where, 
237
-                                 filter => $filter);
256
+    my $ret_val = $self->execute($source, param  => $param, 
257
+                                          filter => $filter);
238 258
     
239 259
     return $ret_val;
240 260
 }
241 261
 
242
-sub delete_all { shift->delete(allow_delete_all => 1, @_) }
262
+sub register_filter {
263
+    my $invocant = shift;
264
+    
265
+    # Register filter
266
+    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
267
+    $invocant->filters({%{$invocant->filters}, %$filters});
268
+    
269
+    return $invocant;
270
+}
243 271
 
244 272
 our %VALID_SELECT_ARGS
245 273
   = map { $_ => 1 } qw/table column where append relation filter param/;
... ...
@@ -320,112 +348,77 @@ sub select {
320 348
     return $result;
321 349
 }
322 350
 
323
-sub create_query {
324
-    my ($self, $source) = @_;
325
-    
326
-    # Cache
327
-    my $cache = $self->cache;
351
+our %VALID_UPDATE_ARGS
352
+  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
353
+
354
+sub update {
355
+    my ($self, %args) = @_;
328 356
     
329
-    # Create query
330
-    my $query;
331
-    if ($cache) {
332
-        
333
-        # Get query
334
-        my $q = $self->cache_method->($self, $source);
335
-        
336
-        # Create query
337
-        $query = DBIx::Custom::Query->new($q) if $q;
357
+    # Check arguments
358
+    foreach my $name (keys %args) {
359
+        croak qq{"$name" is invalid argument}
360
+          unless $VALID_UPDATE_ARGS{$name};
338 361
     }
339 362
     
340
-    unless ($query) {
341
-
342
-        # Create SQL object
343
-        my $builder = $self->query_builder;
344
-        
345
-        # Create query
346
-        $query = $builder->build_query($source);
347
-
348
-        # Cache query
349
-        $self->cache_method->($self, $source,
350
-                             {sql     => $query->sql, 
351
-                              columns => $query->columns})
352
-          if $cache;
353
-    }
363
+    # Arguments
364
+    my $table            = $args{table} || '';
365
+    my $param            = $args{param} || {};
366
+    my $where            = $args{where} || {};
367
+    my $append = $args{append} || '';
368
+    my $filter           = $args{filter};
369
+    my $allow_update_all = $args{allow_update_all};
354 370
     
355
-    # Prepare statement handle
356
-    my $sth;
357
-    eval { $sth = $self->dbh->prepare($query->{sql})};
358
-    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
371
+    # Update keys
372
+    my @update_keys = keys %$param;
359 373
     
360
-    # Set statement handle
361
-    $query->sth($sth);
374
+    # Where keys
375
+    my @where_keys = keys %$where;
362 376
     
363
-    return $query;
364
-}
365
-
366
-sub _croak {
367
-    my ($self, $error, $append) = @_;
368
-    $append ||= "";
377
+    # Not exists where keys
378
+    croak qq{"where" argument must be specified and } .
379
+          qq{contains the pairs of column name and value}
380
+      if !@where_keys && !$allow_update_all;
369 381
     
370
-    # Verbose
371
-    if ($Carp::Verbose) { croak $error }
382
+    # Update clause
383
+    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
372 384
     
373
-    # Not verbose
374
-    else {
375
-        
376
-        # Remove line and module infromation
377
-        my $at_pos = rindex($error, ' at ');
378
-        $error = substr($error, 0, $at_pos);
379
-        $error =~ s/\s+$//;
380
-        
381
-        croak "$error$append";
382
-    }
383
-}
384
-
385
-our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
386
-
387
-sub execute{
388
-    my ($self, $query, %args)  = @_;
385
+    # Where clause
386
+    my $where_clause = '';
387
+    my $new_where = {};
389 388
     
390
-    # Check arguments
391
-    foreach my $name (keys %args) {
392
-        croak qq{"$name" is invalid argument}
393
-          unless $VALID_EXECUTE_ARGS{$name};
389
+    if (@where_keys) {
390
+        $where_clause = 'where ';
391
+        $where_clause .= "{= $_} and " for @where_keys;
392
+        $where_clause =~ s/ and $//;
394 393
     }
395 394
     
396
-    my $params = $args{param} || {};
397
-    
398
-    # First argument is the soruce of SQL
399
-    $query = $self->create_query($query)
400
-      unless ref $query;
401
-    
402
-    my $filter = $args{filter} || $query->filter || {};
403
-    
404
-    # Create bind value
405
-    my $bind_values = $self->_build_bind_values($query, $params, $filter);
406
-    
407
-    # Execute
408
-    my $sth      = $query->sth;
409
-    my $affected;
410
-    eval {$affected = $sth->execute(@$bind_values)};
411
-    $self->_croak($@) if $@;
395
+    # Source of SQL
396
+    my $source = "update $table $update_clause $where_clause";
397
+    $source .= " $append" if $append;
412 398
     
413
-    # Return resultset if select statement is executed
414
-    if ($sth->{NUM_OF_FIELDS}) {
399
+    # Rearrange parameters
400
+    foreach my $wkey (@where_keys) {
415 401
         
416
-        # Create result
417
-        my $result = $self->result_class->new(
418
-            sth            => $sth,
419
-            default_filter => $self->default_fetch_filter,
420
-            filters        => $self->filters,
421
-            filter_check   => $self->filter_check
422
-        );
423
-
424
-        return $result;
402
+        if (exists $param->{$wkey}) {
403
+            $param->{$wkey} = [$param->{$wkey}]
404
+              unless ref $param->{$wkey} eq 'ARRAY';
405
+            
406
+            push @{$param->{$wkey}}, $where->{$wkey};
407
+        }
408
+        else {
409
+            $param->{$wkey} = $where->{$wkey};
410
+        }
425 411
     }
426
-    return $affected;
412
+    
413
+    # Execute query
414
+    my $ret_val = $self->execute($source, param  => $param, 
415
+                                 filter => $filter);
416
+    
417
+    return $ret_val;
427 418
 }
428 419
 
420
+sub update_all { shift->update(allow_update_all => 1, @_) };
421
+
429 422
 sub _build_bind_values {
430 423
     my ($self, $query, $params, $filter) = @_;
431 424
     
... ...
@@ -487,6 +480,25 @@ sub _check_filter {
487 480
     }
488 481
 }
489 482
 
483
+sub _croak {
484
+    my ($self, $error, $append) = @_;
485
+    $append ||= "";
486
+    
487
+    # Verbose
488
+    if ($Carp::Verbose) { croak $error }
489
+    
490
+    # Not verbose
491
+    else {
492
+        
493
+        # Remove line and module infromation
494
+        my $at_pos = rindex($error, ' at ');
495
+        $error = substr($error, 0, $at_pos);
496
+        $error =~ s/\s+$//;
497
+        
498
+        croak "$error$append";
499
+    }
500
+}
501
+
490 502
 1;
491 503
 
492 504
 =head1 NAME
... ...
@@ -1105,21 +1117,37 @@ You can custamize SQL builder object
1105 1117
 
1106 1118
 =head1 ATTRIBUTES
1107 1119
 
1108
-=head2 C<user>
1120
+=head2 C<cache>
1109 1121
 
1110
-    my $user = $dbi->user;
1111
-    $dbi     = $dbi->user('Ken');
1122
+    my $cache = $dbi->cache;
1123
+    $dbi      = $dbi->cache(1);
1112 1124
 
1113
-User name.
1114
-C<connect()> method use this value to connect the database.
1115
-    
1116
-=head2 C<password>
1125
+Enable parsed L<DBIx::Custom::Query> object caching.
1126
+Default to 1.
1117 1127
 
1118
-    my $password = $dbi->password;
1119
-    $dbi         = $dbi->password('lkj&le`@s');
1128
+=head2 C<cache_method>
1120 1129
 
1121
-Password.
1122
-C<connect()> method use this value to connect the database.
1130
+    $dbi          = $dbi->cache_method(\&cache_method);
1131
+    $cache_method = $dbi->cache_method
1132
+
1133
+Method to set and get caches.
1134
+
1135
+B<Example:>
1136
+
1137
+    $dbi->cache_method(
1138
+        sub {
1139
+            my $self = shift;
1140
+            
1141
+            $self->{_cached} ||= {};
1142
+            
1143
+            if (@_ > 1) {
1144
+                $self->{_cached}{$_[0]} = $_[1] 
1145
+            }
1146
+            else {
1147
+                return $self->{_cached}{$_[0]}
1148
+            }
1149
+        }
1150
+    );
1123 1151
 
1124 1152
 =head2 C<data_source>
1125 1153
 
... ...
@@ -1136,14 +1164,6 @@ C<connect()> method use this value to connect the database.
1136 1164
 
1137 1165
 L<DBI> object. You can call all methods of L<DBI>.
1138 1166
 
1139
-=head2 C<filters>
1140
-
1141
-    my $filters = $dbi->filters;
1142
-    $dbi        = $dbi->filters(\%filters);
1143
-
1144
-Filter functions.
1145
-"encode_utf8" and "decode_utf8" is registered by default.
1146
-
1147 1167
 =head2 C<default_bind_filter>
1148 1168
 
1149 1169
     my $default_bind_filter = $dbi->default_bind_filter
... ...
@@ -1158,13 +1178,31 @@ Default filter when parameter binding is executed.
1158 1178
 
1159 1179
 Default filter when row is fetched.
1160 1180
 
1161
-=head2 C<result_class>
1181
+=head2 C<filters>
1162 1182
 
1163
-    my $result_class = $dbi->result_class;
1164
-    $dbi             = $dbi->result_class('DBIx::Custom::Result');
1183
+    my $filters = $dbi->filters;
1184
+    $dbi        = $dbi->filters(\%filters);
1165 1185
 
1166
-Result class for select statement.
1167
-Default to L<DBIx::Custom::Result>.
1186
+Filter functions.
1187
+"encode_utf8" and "decode_utf8" is registered by default.
1188
+
1189
+=head2 C<filter_check>
1190
+
1191
+    my $filter_check = $dbi->filter_check;
1192
+    $dbi             = $dbi->filter_check(0);
1193
+
1194
+Enable filter check. 
1195
+Default to 1.
1196
+This check maybe damege performance.
1197
+If you require performance, set C<filter_check> attribute to 0.
1198
+
1199
+=head2 C<password>
1200
+
1201
+    my $password = $dbi->password;
1202
+    $dbi         = $dbi->password('lkj&le`@s');
1203
+
1204
+Password.
1205
+C<connect()> method use this value to connect the database.
1168 1206
 
1169 1207
 =head2 C<query_builder>
1170 1208
 
... ...
@@ -1175,53 +1213,44 @@ SQL builder. C<query_builder()> must be
1175 1213
 the instance of L<DBIx::Custom::QueryBuilder> subclass.
1176 1214
 Default to L<DBIx::Custom::QueryBuilder> object.
1177 1215
 
1178
-=head2 C<cache>
1179
-
1180
-    my $cache = $dbi->cache;
1181
-    $dbi      = $dbi->cache(1);
1182
-
1183
-Enable parsed L<DBIx::Custom::Query> object caching.
1184
-Default to 1.
1216
+=head2 C<result_class>
1185 1217
 
1186
-=head2 C<cache_method>
1218
+    my $result_class = $dbi->result_class;
1219
+    $dbi             = $dbi->result_class('DBIx::Custom::Result');
1187 1220
 
1188
-    $dbi          = $dbi->cache_method(\&cache_method);
1189
-    $cache_method = $dbi->cache_method
1221
+Result class for select statement.
1222
+Default to L<DBIx::Custom::Result>.
1190 1223
 
1191
-Method to set and get caches.
1224
+=head2 C<user>
1192 1225
 
1193
-B<Example:>
1226
+    my $user = $dbi->user;
1227
+    $dbi     = $dbi->user('Ken');
1194 1228
 
1195
-    $dbi->cache_method(
1196
-        sub {
1197
-            my $self = shift;
1198
-            
1199
-            $self->{_cached} ||= {};
1200
-            
1201
-            if (@_ > 1) {
1202
-                $self->{_cached}{$_[0]} = $_[1] 
1203
-            }
1204
-            else {
1205
-                return $self->{_cached}{$_[0]}
1206
-            }
1207
-        }
1208
-    );
1229
+User name.
1230
+C<connect()> method use this value to connect the database.
1231
+    
1232
+=head1 METHODS
1209 1233
 
1210
-=head2 C<filter_check>
1234
+L<DBIx::Custom> inherits all methods from L<Object::Simple>
1235
+and implements the following new ones.
1211 1236
 
1212
-    my $filter_check = $dbi->filter_check;
1213
-    $dbi             = $dbi->filter_check(0);
1237
+=head2 begin_work
1214 1238
 
1215
-Enable filter check. 
1216
-Default to 1.
1217
-This check maybe damege performance.
1218
-If you require performance, set C<filter_check> attribute to 0.
1239
+    $dbi->begin_work;
1219 1240
 
1220
-=head1 METHODS
1241
+Start transaction.
1242
+This is same as L<DBI>'s C<begin_work>.
1221 1243
 
1222 1244
 L<DBIx::Custom> inherits all methods from L<Object::Simple>
1223 1245
 and implements the following new ones.
1224 1246
 
1247
+=head2 commit
1248
+
1249
+    $dbi->commit;
1250
+
1251
+Commit transaction.
1252
+This is same as L<DBI>'s C<commit>.
1253
+
1225 1254
 =head2 C<connect>
1226 1255
 
1227 1256
     my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
... ...
@@ -1232,74 +1261,40 @@ L<DBIx::Custom> is a wrapper of L<DBI>.
1232 1261
 C<AutoCommit> and C<RaiseError> options are true, 
1233 1262
 and C<PrintError> option is false by default. 
1234 1263
 
1235
-=head2 C<insert>
1236
-
1237
-    $dbi->insert(table  => $table, 
1238
-                 param  => \%param,
1239
-                 append => $append,
1240
-                 filter => \%filter);
1241
-
1242
-Execute insert statement.
1243
-C<insert> method have C<table>, C<param>, C<append>
1244
-and C<filter> arguments.
1245
-C<table> is a table name.
1246
-C<param> is the pairs of column name value. this must be hash reference.
1247
-C<append> is a string added at the end of the SQL statement.
1248
-C<filter> is filters when parameter binding is executed.
1249
-This is overwrites C<default_bind_filter>.
1250
-Return value of C<insert()> is the count of affected rows.
1251
-
1252
-B<Example:>
1253
-
1254
-    $dbi->insert(table  => 'books', 
1255
-                 param  => {title => 'Perl', author => 'Taro'},
1256
-                 append => "some statement",
1257
-                 filter => {title => 'encode_utf8'})
1258
-
1259
-=head2 C<update>
1260
-
1261
-    $dbi->update(table  => $table, 
1262
-                 param  => \%params,
1263
-                 where  => \%where,
1264
-                 append => $append,
1265
-                 filter => \%filter)
1266
-
1267
-Execute update statement.
1268
-C<update> method have C<table>, C<param>, C<where>, C<append>
1269
-and C<filter> arguments.
1270
-C<table> is a table name.
1271
-C<param> is column-value pairs. this must be hash reference.
1272
-C<where> is where clause. this must be hash reference.
1273
-C<append> is a string added at the end of the SQL statement.
1274
-C<filter> is filters when parameter binding is executed.
1275
-This is overwrites C<default_bind_filter>.
1276
-Return value of C<update()> is the count of affected rows.
1264
+=head2 C<create_query>
1265
+    
1266
+    my $query = $dbi->create_query(
1267
+        "select * from books where {= author} and {like title};"
1268
+    );
1277 1269
 
1278
-B<Example:>
1270
+Create the instance of L<DBIx::Custom::Query> from the source of SQL.
1271
+If you want to get high performance,
1272
+use C<create_query()> method and execute it by C<execute()> method
1273
+instead of suger methods.
1279 1274
 
1280
-    $dbi->update(table  => 'books',
1281
-                 param  => {title => 'Perl', author => 'Taro'},
1282
-                 where  => {id => 5},
1283
-                 append => "some statement",
1284
-                 filter => {title => 'encode_utf8'});
1275
+    $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
1285 1276
 
1286
-=head2 C<update_all>
1277
+=head2 C<execute>
1287 1278
 
1288
-    $dbi->update_all(table  => $table, 
1289
-                     param  => \%params,
1290
-                     filter => \%filter,
1291
-                     append => $append);
1279
+    my $result = $dbi->execute($query,  param => $params, filter => \%filter);
1280
+    my $result = $dbi->execute($source, param => $params, filter => \%filter);
1292 1281
 
1293
-Execute update statement to update all rows.
1294
-Arguments is same as C<update> method,
1295
-except that C<update_all> don't have C<where> argument.
1296
-Return value of C<update_all()> is the count of affected rows.
1282
+Execute query or the source of SQL.
1283
+Query is L<DBIx::Custom::Query> object.
1284
+Return value is L<DBIx::Custom::Result> if select statement is executed,
1285
+or the count of affected rows if insert, update, delete statement is executed.
1297 1286
 
1298 1287
 B<Example:>
1299 1288
 
1300
-    $dbi->update_all(table  => 'books', 
1301
-                     param  => {author => 'taro'},
1302
-                     filter => {author => 'encode_utf8'});
1289
+    my $result = $dbi->execute(
1290
+        "select * from books where {= author} and {like title}", 
1291
+        param => {author => 'Ken', title => '%Perl%'}
1292
+    );
1293
+    
1294
+    while (my $row = $result->fetch) {
1295
+        my $author = $row->[0];
1296
+        my $title  = $row->[1];
1297
+    }
1303 1298
 
1304 1299
 =head2 C<delete>
1305 1300
 
... ...
@@ -1336,6 +1331,90 @@ B<Example:>
1336 1331
     
1337 1332
     $dbi->delete_all(table => 'books');
1338 1333
 
1334
+=head2 C<insert>
1335
+
1336
+    $dbi->insert(table  => $table, 
1337
+                 param  => \%param,
1338
+                 append => $append,
1339
+                 filter => \%filter);
1340
+
1341
+Execute insert statement.
1342
+C<insert> method have C<table>, C<param>, C<append>
1343
+and C<filter> arguments.
1344
+C<table> is a table name.
1345
+C<param> is the pairs of column name value. this must be hash reference.
1346
+C<append> is a string added at the end of the SQL statement.
1347
+C<filter> is filters when parameter binding is executed.
1348
+This is overwrites C<default_bind_filter>.
1349
+Return value of C<insert()> is the count of affected rows.
1350
+
1351
+B<Example:>
1352
+
1353
+    $dbi->insert(table  => 'books', 
1354
+                 param  => {title => 'Perl', author => 'Taro'},
1355
+                 append => "some statement",
1356
+                 filter => {title => 'encode_utf8'})
1357
+
1358
+=head2 C<register_filter>
1359
+
1360
+    $dbi->register_filter(%filters);
1361
+    $dbi->register_filter(\%filters);
1362
+    
1363
+Register filter. Registered filters is available in the following attributes
1364
+or arguments.
1365
+
1366
+=over 4
1367
+
1368
+=item *
1369
+
1370
+C<default_bind_filter>, C<default_fetch_filter>
1371
+
1372
+=item *
1373
+
1374
+C<filter> argument of C<insert()>, C<update()>,
1375
+C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1376
+methods
1377
+
1378
+=item *
1379
+
1380
+C<execute()> method
1381
+
1382
+=item *
1383
+
1384
+C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1385
+
1386
+=item *
1387
+
1388
+C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1389
+
1390
+=back
1391
+
1392
+B<Example:>
1393
+
1394
+    $dbi->register_filter(
1395
+        encode_utf8 => sub {
1396
+            my $value = shift;
1397
+            
1398
+            require Encode;
1399
+            
1400
+            return Encode::encode('UTF-8', $value);
1401
+        },
1402
+        decode_utf8 => sub {
1403
+            my $value = shift;
1404
+            
1405
+            require Encode;
1406
+            
1407
+            return Encode::decode('UTF-8', $value)
1408
+        }
1409
+    );
1410
+
1411
+=head2 rollback
1412
+
1413
+    $dbi->rollback;
1414
+
1415
+Rollback transaction.
1416
+This is same as L<DBI>'s C<rollback>.
1417
+
1339 1418
 =head2 C<select>
1340 1419
     
1341 1420
     my $result = $dbi->select(table    => $table,
... ...
@@ -1391,93 +1470,50 @@ First element is a string. it contains tags,
1391 1470
 such as "{= title} or {like author}".
1392 1471
 Second element is paramters.
1393 1472
 
1394
-=head2 C<create_query>
1395
-    
1396
-    my $query = $dbi->create_query(
1397
-        "select * from books where {= author} and {like title};"
1398
-    );
1399
-
1400
-Create the instance of L<DBIx::Custom::Query> from the source of SQL.
1401
-If you want to get high performance,
1402
-use C<create_query()> method and execute it by C<execute()> method
1403
-instead of suger methods.
1404
-
1405
-    $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
1406
-
1407
-=head2 C<execute>
1473
+=head2 C<update>
1408 1474
 
1409
-    my $result = $dbi->execute($query,  param => $params, filter => \%filter);
1410
-    my $result = $dbi->execute($source, param => $params, filter => \%filter);
1475
+    $dbi->update(table  => $table, 
1476
+                 param  => \%params,
1477
+                 where  => \%where,
1478
+                 append => $append,
1479
+                 filter => \%filter)
1411 1480
 
1412
-Execute query or the source of SQL.
1413
-Query is L<DBIx::Custom::Query> object.
1414
-Return value is L<DBIx::Custom::Result> if select statement is executed,
1415
-or the count of affected rows if insert, update, delete statement is executed.
1481
+Execute update statement.
1482
+C<update> method have C<table>, C<param>, C<where>, C<append>
1483
+and C<filter> arguments.
1484
+C<table> is a table name.
1485
+C<param> is column-value pairs. this must be hash reference.
1486
+C<where> is where clause. this must be hash reference.
1487
+C<append> is a string added at the end of the SQL statement.
1488
+C<filter> is filters when parameter binding is executed.
1489
+This is overwrites C<default_bind_filter>.
1490
+Return value of C<update()> is the count of affected rows.
1416 1491
 
1417 1492
 B<Example:>
1418 1493
 
1419
-    my $result = $dbi->execute(
1420
-        "select * from books where {= author} and {like title}", 
1421
-        param => {author => 'Ken', title => '%Perl%'}
1422
-    );
1423
-    
1424
-    while (my $row = $result->fetch) {
1425
-        my $author = $row->[0];
1426
-        my $title  = $row->[1];
1427
-    }
1428
-
1429
-=head2 C<register_filter>
1430
-
1431
-    $dbi->register_filter(%filters);
1432
-    $dbi->register_filter(\%filters);
1433
-    
1434
-Register filter. Registered filters is available in the following attributes
1435
-or arguments.
1436
-
1437
-=over 4
1438
-
1439
-=item *
1440
-
1441
-C<default_bind_filter>, C<default_fetch_filter>
1442
-
1443
-=item *
1444
-
1445
-C<filter> argument of C<insert()>, C<update()>,
1446
-C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1447
-methods
1448
-
1449
-=item *
1450
-
1451
-C<execute()> method
1452
-
1453
-=item *
1454
-
1455
-C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1494
+    $dbi->update(table  => 'books',
1495
+                 param  => {title => 'Perl', author => 'Taro'},
1496
+                 where  => {id => 5},
1497
+                 append => "some statement",
1498
+                 filter => {title => 'encode_utf8'});
1456 1499
 
1457
-=item *
1500
+=head2 C<update_all>
1458 1501
 
1459
-C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1502
+    $dbi->update_all(table  => $table, 
1503
+                     param  => \%params,
1504
+                     filter => \%filter,
1505
+                     append => $append);
1460 1506
 
1461
-=back
1507
+Execute update statement to update all rows.
1508
+Arguments is same as C<update> method,
1509
+except that C<update_all> don't have C<where> argument.
1510
+Return value of C<update_all()> is the count of affected rows.
1462 1511
 
1463 1512
 B<Example:>
1464 1513
 
1465
-    $dbi->register_filter(
1466
-        encode_utf8 => sub {
1467
-            my $value = shift;
1468
-            
1469
-            require Encode;
1470
-            
1471
-            return Encode::encode('UTF-8', $value);
1472
-        },
1473
-        decode_utf8 => sub {
1474
-            my $value = shift;
1475
-            
1476
-            require Encode;
1477
-            
1478
-            return Encode::decode('UTF-8', $value)
1479
-        }
1480
-    );
1514
+    $dbi->update_all(table  => 'books', 
1515
+                     param  => {author => 'taro'},
1516
+                     filter => {author => 'encode_utf8'});
1481 1517
 
1482 1518
 =head1 STABILITY
1483 1519
 
+8 -8
lib/DBIx/Custom/Query.pm
... ...
@@ -5,7 +5,7 @@ use warnings;
5 5
 
6 6
 use base 'Object::Simple';
7 7
 
8
-__PACKAGE__->attr([qw/sql columns default_filter filter sth/]);
8
+__PACKAGE__->attr([qw/columns default_filter filter sql sth/]);
9 9
 
10 10
 1;
11 11
 
... ...
@@ -19,13 +19,6 @@ DBIx::Custom::Query - Query
19 19
     
20 20
 =head1 ATTRIBUTES
21 21
 
22
-=head2 C<sql>
23
-
24
-    my $sql = $query->sql;
25
-    $query  = $query->sql('select * from books where author = ?;');
26
-
27
-SQL statement.
28
-
29 22
 =head2 C<columns>
30 23
 
31 24
     my $columns = $query->columns;
... ...
@@ -49,6 +42,13 @@ Default filter when parameter binding is executed.
49 42
 Filters when parameter binding is executed.
50 43
 This overwrites C<default_filter>.
51 44
 
45
+=head2 C<sql>
46
+
47
+    my $sql = $query->sql;
48
+    $query  = $query->sql('select * from books where author = ?;');
49
+
50
+SQL statement.
51
+
52 52
 =head2 C<sth>
53 53
 
54 54
     my $sth = $query->sth;
+77 -74
lib/DBIx/Custom/QueryBuilder.pm
... ...
@@ -12,7 +12,10 @@ use DBIx::Custom::QueryBuilder::TagProcessors;
12 12
 # Carp trust relationship
13 13
 push @DBIx::Custom::CARP_NOT, __PACKAGE__;
14 14
 
15
+# Attributes
15 16
 __PACKAGE__->dual_attr('tag_processors', default => sub { {} }, inherit => 'hash_copy');
17
+
18
+# Resister tag processor
16 19
 __PACKAGE__->register_tag_processor(
17 20
     '?'     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_placeholder_tag,
18 21
     '='     => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_equal_tag,
... ...
@@ -27,6 +30,18 @@ __PACKAGE__->register_tag_processor(
27 30
     'update_param' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_update_param_tag
28 31
 );
29 32
 
33
+sub build_query {
34
+    my ($self, $source)  = @_;
35
+    
36
+    # Parse
37
+    my $tree = $self->_parse($source);
38
+    
39
+    # Build query
40
+    my $query = $self->_build_query($tree);
41
+    
42
+    return $query;
43
+}
44
+
30 45
 sub register_tag_processor {
31 46
     my $self = shift;
32 47
     
... ...
@@ -37,14 +52,70 @@ sub register_tag_processor {
37 52
     return $self;
38 53
 }
39 54
 
40
-sub build_query {
41
-    my ($self, $source)  = @_;
55
+sub _build_query {
56
+    my ($self, $tree) = @_;
42 57
     
43
-    # Parse
44
-    my $tree = $self->_parse($source);
58
+    # SQL
59
+    my $sql = '';
45 60
     
46
-    # Build query
47
-    my $query = $self->_build_query($tree);
61
+    # All Columns
62
+    my $all_columns = [];
63
+    
64
+    # Build SQL 
65
+    foreach my $node (@$tree) {
66
+        
67
+        # Text
68
+        if ($node->{type} eq 'text') { $sql .= $node->{value} }
69
+        
70
+        # Tag
71
+        else {
72
+            
73
+            # Tag name
74
+            my $tag_name = $node->{tag_name};
75
+            
76
+            # Tag arguments
77
+            my $tag_args = $node->{tag_args};
78
+            
79
+            # Get tag processor
80
+            my $tag_processor = $self->tag_processors->{$tag_name};
81
+            
82
+            # Tag processor is not registered
83
+            croak qq{Tag "$tag_name" in "{a }" is not registered}
84
+              unless $tag_processor;
85
+            
86
+            # Tag processor not sub reference
87
+            croak qq{Tag processor "$tag_name" must be sub reference}
88
+              unless ref $tag_processor eq 'CODE';
89
+            
90
+            # Execute tag processor
91
+            my $r = $tag_processor->(@$tag_args);
92
+            
93
+            # Check tag processor return value
94
+            croak qq{Tag processor "$tag_name" must return [STRING, ARRAY_REFERENCE]}
95
+              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
96
+            
97
+            # Part of SQL statement and colum names
98
+            my ($part, $columns) = @$r;
99
+            
100
+            # Add columns
101
+            push @$all_columns, @$columns;
102
+            
103
+            # Join part tag to SQL
104
+            $sql .= $part;
105
+        }
106
+    }
107
+
108
+    # Check placeholder count
109
+    my $placeholder_count = $self->_placeholder_count($sql);
110
+    my $column_count      = @$all_columns;
111
+    croak qq{Placeholder count in "$sql" must be same as column count $column_count}
112
+      unless $placeholder_count eq @$all_columns;
113
+    
114
+    # Add semicolon
115
+    $sql .= ';' unless $sql =~ /;$/;
116
+    
117
+    # Query
118
+    my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);
48 119
     
49 120
     return $query;
50 121
 }
... ...
@@ -190,74 +261,6 @@ sub _parse {
190 261
     return \@tree;
191 262
 }
192 263
 
193
-sub _build_query {
194
-    my ($self, $tree) = @_;
195
-    
196
-    # SQL
197
-    my $sql = '';
198
-    
199
-    # All Columns
200
-    my $all_columns = [];
201
-    
202
-    # Build SQL 
203
-    foreach my $node (@$tree) {
204
-        
205
-        # Text
206
-        if ($node->{type} eq 'text') { $sql .= $node->{value} }
207
-        
208
-        # Tag
209
-        else {
210
-            
211
-            # Tag name
212
-            my $tag_name = $node->{tag_name};
213
-            
214
-            # Tag arguments
215
-            my $tag_args = $node->{tag_args};
216
-            
217
-            # Get tag processor
218
-            my $tag_processor = $self->tag_processors->{$tag_name};
219
-            
220
-            # Tag processor is not registered
221
-            croak qq{Tag "$tag_name" in "{a }" is not registered}
222
-              unless $tag_processor;
223
-            
224
-            # Tag processor not sub reference
225
-            croak qq{Tag processor "$tag_name" must be sub reference}
226
-              unless ref $tag_processor eq 'CODE';
227
-            
228
-            # Execute tag processor
229
-            my $r = $tag_processor->(@$tag_args);
230
-            
231
-            # Check tag processor return value
232
-            croak qq{Tag processor "$tag_name" must return [STRING, ARRAY_REFERENCE]}
233
-              unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';
234
-            
235
-            # Part of SQL statement and colum names
236
-            my ($part, $columns) = @$r;
237
-            
238
-            # Add columns
239
-            push @$all_columns, @$columns;
240
-            
241
-            # Join part tag to SQL
242
-            $sql .= $part;
243
-        }
244
-    }
245
-
246
-    # Check placeholder count
247
-    my $placeholder_count = $self->_placeholder_count($sql);
248
-    my $column_count      = @$all_columns;
249
-    croak qq{Placeholder count in "$sql" must be same as column count $column_count}
250
-      unless $placeholder_count eq @$all_columns;
251
-    
252
-    # Add semicolon
253
-    $sql .= ';' unless $sql =~ /;$/;
254
-    
255
-    # Query
256
-    my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);
257
-    
258
-    return $query;
259
-}
260
-
261 264
 sub _placeholder_count {
262 265
     my ($self, $expand) = @_;
263 266
     
+40 -39
lib/DBIx/Custom/QueryBuilder/TagProcessors.pm
... ...
@@ -8,33 +8,9 @@ use Carp 'croak';
8 8
 # Carp trust relationship
9 9
 push @DBIx::Custom::QueryBuilder::CARP_NOT, __PACKAGE__;
10 10
 
11
-sub _expand_basic_tag {
12
-    my ($name, $column) = @_;
13
-    
14
-    # Check arguments
15
-    croak qq{Column name must be specified in tag "{$name }"}
16
-      unless $column;
17
-    
18
-    return ["$column $name ?", [$column]];
19
-}
20
-
21 11
 sub expand_equal_tag              { _expand_basic_tag('=',    @_) }
22
-sub expand_not_equal_tag          { _expand_basic_tag('<>',   @_) }
23
-sub expand_greater_than_tag       { _expand_basic_tag('>',    @_) }
24
-sub expand_lower_than_tag         { _expand_basic_tag('<',    @_) }
25 12
 sub expand_greater_than_equal_tag { _expand_basic_tag('>=',   @_) }
26
-sub expand_lower_than_equal_tag   { _expand_basic_tag('<=',   @_) }
27
-sub expand_like_tag               { _expand_basic_tag('like', @_) }
28
-
29
-sub expand_placeholder_tag {
30
-    my $column = shift;
31
-    
32
-    # Check arguments
33
-    croak qq{Column name must be specified in tag "{? }"}
34
-      unless $column;
35
-    
36
-    return ['?', [$column]];
37
-}
13
+sub expand_greater_than_tag       { _expand_basic_tag('>',    @_) }
38 14
 
39 15
 sub expand_in_tag {
40 16
     my ($column, $count) = @_;
... ...
@@ -74,6 +50,21 @@ sub expand_insert_param_tag {
74 50
     return [$s, \@columns];
75 51
 }
76 52
 
53
+sub expand_like_tag               { _expand_basic_tag('like', @_) }
54
+sub expand_lower_than_equal_tag   { _expand_basic_tag('<=',   @_) }
55
+sub expand_lower_than_tag         { _expand_basic_tag('<',    @_) }
56
+sub expand_not_equal_tag          { _expand_basic_tag('<>',   @_) }
57
+
58
+sub expand_placeholder_tag {
59
+    my $column = shift;
60
+    
61
+    # Check arguments
62
+    croak qq{Column name must be specified in tag "{? }"}
63
+      unless $column;
64
+    
65
+    return ['?', [$column]];
66
+}
67
+
77 68
 sub expand_update_param_tag {
78 69
     my @columns = @_;
79 70
     
... ...
@@ -85,6 +76,16 @@ sub expand_update_param_tag {
85 76
     return [$s, \@columns];
86 77
 }
87 78
 
79
+sub _expand_basic_tag {
80
+    my ($name, $column) = @_;
81
+    
82
+    # Check arguments
83
+    croak qq{Column name must be specified in tag "{$name }"}
84
+      unless $column;
85
+    
86
+    return ["$column $name ?", [$column]];
87
+}
88
+
88 89
 1;
89 90
 
90 91
 =head1 NAME
... ...
@@ -115,37 +116,29 @@ same as the count of column names.
115 116
         return [$s, $columns];
116 117
     }
117 118
 
118
-=head2 C<expand_placeholder_tag>
119
-
120
-    ('NAME')  ->  ['?', ['NAME']]
121
-
122 119
 =head2 C<expand_equal_tag>
123 120
 
124 121
     ('NAME')  ->  ['NAME = ?', ['NAME']]
125 122
 
126
-=head2 C<expand_not_equal_tag>
123
+=head2 C<expand_greater_than_equal_tag>
127 124
 
128
-    ('NAME')  ->  ['NAME <> ?', ['NAME']]
125
+    ('NAME')  ->  ['NAME >= ?', ['NAME']]
129 126
 
130 127
 =head2 C<expand_greater_than_tag>
131 128
 
132 129
     ('NAME')  ->  ['NAME > ?', ['NAME']]
133 130
 
134
-=head2 C<expand_lower_than_tag>
135
-
136
-    ('NAME')  ->  ['NAME < ?', ['NAME']]
137
-
138
-=head2 C<expand_greater_than_equal_tag>
131
+=head2 C<expand_like_tag>
139 132
 
140
-    ('NAME')  ->  ['NAME >= ?', ['NAME']]
133
+    ('NAME')  ->  ['NAME like ?', ['NAME']]
141 134
 
142 135
 =head2 C<expand_lower_than_equal_tag>
143 136
 
144 137
     ('NAME')  ->  ['NAME <= ?', ['NAME']]
145 138
 
146
-=head2 C<expand_like_tag>
139
+=head2 C<expand_lower_than_tag>
147 140
 
148
-    ('NAME')  ->  ['NAME like ?', ['NAME']]
141
+    ('NAME')  ->  ['NAME < ?', ['NAME']]
149 142
 
150 143
 =head2 C<expand_in_tag>
151 144
 
... ...
@@ -156,6 +149,14 @@ same as the count of column names.
156 149
     ('NAME1', 'NAME2')
157 150
       ->  ['(NAME1, NAME2) values (?, ?, ?)', ['NAME1', 'NAME2']]
158 151
 
152
+=head2 C<expand_not_equal_tag>
153
+
154
+    ('NAME')  ->  ['NAME <> ?', ['NAME']]
155
+
156
+=head2 C<expand_placeholder_tag>
157
+
158
+    ('NAME')  ->  ['?', ['NAME']]
159
+
159 160
 =head2 C<expand_update_param_tag>
160 161
 
161 162
     ('NAME1', 'NAME2')
+73 -59
lib/DBIx/Custom/Result.pm
... ...
@@ -7,7 +7,7 @@ use base 'Object::Simple';
7 7
 
8 8
 use Carp 'croak';
9 9
 
10
-__PACKAGE__->attr([qw/sth filters default_filter filter filter_check/]);
10
+__PACKAGE__->attr([qw/default_filter filter filter_check filters sth/]);
11 11
 
12 12
 sub fetch {
13 13
     my $self = shift;
... ...
@@ -45,6 +45,17 @@ sub fetch {
45 45
     return \@row;
46 46
 }
47 47
 
48
+sub fetch_all {
49
+    my $self = shift;
50
+    
51
+    # Fetch all rows
52
+    my $rows = [];
53
+    while(my $row = $self->fetch) {
54
+        push @$rows, $row;
55
+    }
56
+    return $rows;
57
+}
58
+
48 59
 sub fetch_first {
49 60
     my $self = shift;
50 61
     
... ...
@@ -60,36 +71,6 @@ sub fetch_first {
60 71
     return $row;
61 72
 }
62 73
 
63
-sub fetch_multi {
64
-    my ($self, $count) = @_;
65
-    
66
-    # Row count not specifed
67
-    croak 'Row count must be specified'
68
-      unless $count;
69
-    
70
-    # Fetch multi rows
71
-    my $rows = [];
72
-    for (my $i = 0; $i < $count; $i++) {
73
-        my $row = $self->fetch;
74
-        last unless $row;
75
-        push @$rows, $row;
76
-    }
77
-    
78
-    return unless @$rows;
79
-    return $rows;
80
-}
81
-
82
-sub fetch_all {
83
-    my $self = shift;
84
-    
85
-    # Fetch all rows
86
-    my $rows = [];
87
-    while(my $row = $self->fetch) {
88
-        push @$rows, $row;
89
-    }
90
-    return $rows;
91
-}
92
-
93 74
 sub fetch_hash {
94 75
     my $self = shift;
95 76
     
... ...
@@ -128,6 +109,18 @@ sub fetch_hash {
128 109
     return $row_hash;
129 110
 }
130 111
 
112
+sub fetch_hash_all {
113
+    my $self = shift;
114
+    
115
+    # Fetch all rows as hash
116
+    my $rows = [];
117
+    while(my $row = $self->fetch_hash) {
118
+        push @$rows, $row;
119
+    }
120
+    
121
+    return $rows;
122
+}
123
+
131 124
 sub fetch_hash_first {
132 125
     my $self = shift;
133 126
     
... ...
@@ -162,15 +155,22 @@ sub fetch_hash_multi {
162 155
     return $rows;
163 156
 }
164 157
 
165
-sub fetch_hash_all {
166
-    my $self = shift;
158
+sub fetch_multi {
159
+    my ($self, $count) = @_;
167 160
     
168
-    # Fetch all rows as hash
161
+    # Row count not specifed
162
+    croak 'Row count must be specified'
163
+      unless $count;
164
+    
165
+    # Fetch multi rows
169 166
     my $rows = [];
170
-    while(my $row = $self->fetch_hash) {
167
+    for (my $i = 0; $i < $count; $i++) {
168
+        my $row = $self->fetch;
169
+        last unless $row;
171 170
         push @$rows, $row;
172 171
     }
173 172
     
173
+    return unless @$rows;
174 174
     return $rows;
175 175
 }
176 176
 
... ...
@@ -261,13 +261,6 @@ Fetch row into hash.
261 261
 
262 262
 =head1 ATTRIBUTES
263 263
 
264
-=head2 C<sth>
265
-
266
-    my $sth = $reuslt->sth
267
-    $result = $result->sth($sth);
268
-
269
-Statement handle of L<DBI>.
270
-
271 264
 =head2 C<default_filter>
272 265
 
273 266
     my $default_filter = $result->default_filter;
... ...
@@ -284,6 +277,27 @@ Default filter when a row is fetched.
284 277
 Filters when a row is fetched.
285 278
 This overwrites C<default_filter>.
286 279
 
280
+=head2 C<filters>
281
+
282
+    my $filters = $result->filters;
283
+    $result     = $result->filters(\%filters);
284
+
285
+Resistered filters.
286
+
287
+=head2 C<filter_check>
288
+
289
+    my $filter_check = $result->filter_check;
290
+    $result          = $result->filter_check;
291
+
292
+Enable filter validation.
293
+
294
+=head2 C<sth>
295
+
296
+    my $sth = $reuslt->sth
297
+    $result = $result->sth($sth);
298
+
299
+Statement handle of L<DBI>.
300
+
287 301
 =head1 METHODS
288 302
 
289 303
 L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>
... ...
@@ -295,31 +309,30 @@ and implements the following new ones.
295 309
 
296 310
 Fetch a row into array.
297 311
 
298
-=head2 C<fetch_first>
299
-
300
-    my $row = $result->fetch_first;
301
-
302
-Fetch only a first row into array and finish statment handle.
303
-
304
-=head2 C<fetch_multi>
305
-
306
-    my $rows = $result->fetch_multi(5);
307
-    
308
-Fetch multiple rows into array of array.
309
-Row count must be specified.
310
-
311 312
 =head2 C<fetch_all>
312 313
 
313 314
     my $rows = $result->fetch_all;
314 315
 
315 316
 Fetch all rows into array of array.
316 317
 
318
+=head2 C<fetch_first>
319
+
320
+    my $row = $result->fetch_first;
321
+
322
+Fetch only a first row into array and finish statment handle.
323
+
317 324
 =head2 C<fetch_hash>
318 325
 
319 326
     my $row = $result->fetch_hash;
320 327
 
321 328
 Fetch a row into hash
322 329
 
330
+=head2 C<fetch_hash_all>
331
+
332
+    my $rows = $result->fetch_hash_all;
333
+
334
+Fetch all rows into array of hash.
335
+
323 336
 =head2 C<fetch_hash_first>
324 337
     
325 338
     my $row = $result->fetch_hash_first;
... ...
@@ -333,10 +346,11 @@ Fetch only first row into hash and finish statment handle.
333 346
 Fetch multiple rows into array of hash
334 347
 Row count must be specified.
335 348
 
336
-=head2 C<fetch_hash_all>
337
-
338
-    my $rows = $result->fetch_hash_all;
349
+=head2 C<fetch_multi>
339 350
 
340
-Fetch all rows into array of hash.
351
+    my $rows = $result->fetch_multi(5);
352
+    
353
+Fetch multiple rows into array of array.
354
+Row count must be specified.
341 355
 
342 356
 =cut
+38 -2
t/dbix-custom-core-sqlite.t
... ...
@@ -21,8 +21,6 @@ sub test {
21 21
     $test = shift;
22 22
 }
23 23
 
24
-use DBIx::Custom::SQLite;
25
-
26 24
 # Constant varialbes for test
27 25
 my $CREATE_TABLE = {
28 26
     0 => 'create table table1 (key1 char(255), key2 char(255));',
... ...
@@ -572,3 +570,41 @@ ok($@, "$test: execute fail");
572 570
     eval{$dbi->create_query('select * from table1 where {0 key1}')};
573 571
     like($@, qr/QueryBuilder.*\.t /s, "$test : caller spec : not vebose");
574 572
 }
573
+
574
+
575
+test 'transaction';
576
+$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
577
+$dbi->execute($CREATE_TABLE->{0});
578
+
579
+$dbi->begin_work;
580
+
581
+eval {
582
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
583
+    die "Error";
584
+    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
585
+};
586
+
587
+$dbi->rollback if $@;
588
+
589
+$result = $dbi->select(table => 'table1');
590
+$rows = $result->fetch_hash_all;
591
+is_deeply($rows, [], "$test : rollback");
592
+
593
+$dbi->begin_work;
594
+
595
+eval {
596
+    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
597
+    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
598
+};
599
+
600
+$dbi->commit unless $@;
601
+
602
+$result = $dbi->select(table => 'table1');
603
+$rows = $result->fetch_hash_all;
604
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : commit");
605
+
606
+$dbi->dbh->{AutoCommit} = 0;
607
+eval{ $dbi->begin_work };
608
+ok($@, "$test : exception");
609
+$dbi->dbh->{AutoCommit} = 1;
610
+