Showing 2 changed files with 117 additions and 124 deletions
+116 -123
lib/DBIx/Custom.pm
... ...
@@ -1,6 +1,6 @@
1 1
 package DBIx::Custom;
2 2
 
3
-our $VERSION = '0.1670';
3
+our $VERSION = '0.1671';
4 4
 
5 5
 use 5.008001;
6 6
 use strict;
... ...
@@ -67,7 +67,7 @@ sub AUTOLOAD {
67 67
     # Method name
68 68
     my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
69 69
 
70
-    # Method
70
+    # Call method
71 71
     $self->{_methods} ||= {};
72 72
     if (my $method = $self->{_methods}->{$mname}) {
73 73
         return $self->$method(@_)
... ...
@@ -89,16 +89,16 @@ sub apply_filter {
89 89
     $self->{filter}{in} ||= {};
90 90
     $self->{filter}{end} ||= {};
91 91
     
92
-    # Create filters
92
+    # Usage
93 93
     my $usage = "Usage: \$dbi->apply_filter(" .
94 94
                 "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
95 95
                 "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
96
-
96
+    
97
+    # Apply filter
97 98
     for (my $i = 0; $i < @cinfos; $i += 2) {
98 99
         
99 100
         # Column
100 101
         my $column = $cinfos[$i];
101
-        
102 102
         if (ref $column eq 'ARRAY') {
103 103
             foreach my $c (@$column) {
104 104
                 push @cinfos, $c, $cinfos[$i + 1];
... ...
@@ -106,7 +106,7 @@ sub apply_filter {
106 106
             next;
107 107
         }
108 108
         
109
-        # Filter info
109
+        # Filter infomation
110 110
         my $finfo = $cinfos[$i + 1] || {};
111 111
         croak "$usage (table: $table)" unless  ref $finfo eq 'HASH';
112 112
         foreach my $ftype (keys %$finfo) {
... ...
@@ -114,23 +114,27 @@ sub apply_filter {
114 114
                              || $ftype eq 'end'; 
115 115
         }
116 116
         
117
+        # Set filters
117 118
         foreach my $way (qw/in out end/) {
119
+        
120
+            # Filter
118 121
             my $filter = $finfo->{$way};
119 122
             
120
-            # State
123
+            # Filter state
121 124
             my $state = !exists $finfo->{$way} ? 'not_exists'
122 125
                       : !defined $filter        ? 'not_defined'
123 126
                       : ref $filter eq 'CODE'   ? 'code'
124 127
                       : 'name';
125 128
             
129
+            # Filter is not exists
126 130
             next if $state eq 'not_exists';
127 131
             
128
-            # Check filter
132
+            # Check filter name
129 133
             croak qq{Filter "$filter" is not registered}
130 134
               if  $state eq 'name'
131 135
                && ! exists $self->filters->{$filter};
132 136
             
133
-            # Filter
137
+            # Set filter
134 138
             my $f = $state eq 'not_defined' ? undef
135 139
                   : $state eq 'code'        ? $filter
136 140
                   : $self->filters->{$filter};
... ...
@@ -146,11 +150,12 @@ sub apply_filter {
146 150
 sub column {
147 151
     my ($self, $table, $columns) = @_;
148 152
     
149
-    $columns ||= [];
150
-    
153
+    # Reserved word quote
151 154
     my $q = $self->reserved_word_quote;
152 155
     
156
+    # Column clause
153 157
     my @column;
158
+    $columns ||= [];
154 159
     push @column, "$q$table$q.$q$_$q as $q${table}${q}__$q$_$q" for @$columns;
155 160
     
156 161
     return join (', ', @column);
... ...
@@ -159,12 +164,13 @@ sub column {
159 164
 sub connect {
160 165
     my $self = ref $_[0] ? shift : shift->new(@_);;
161 166
     
167
+    # Connect and get database handle
162 168
     my $dbh = $self->_connect;
163 169
     
164
-    # Database handle
170
+    # Set database handle
165 171
     $self->dbh($dbh);
166 172
     
167
-    # Process ID
173
+    # Set process ID
168 174
     $self->pid($$);
169 175
     
170 176
     return $self;
... ...
@@ -176,8 +182,10 @@ sub create_query {
176 182
     # Cache
177 183
     my $cache = $self->cache;
178 184
     
179
-    # Create query
185
+    # Query
180 186
     my $query;
187
+    
188
+    # Get cached query
181 189
     if ($cache) {
182 190
         
183 191
         # Get query
... ...
@@ -190,28 +198,27 @@ sub create_query {
190 198
         }
191 199
     }
192 200
     
201
+    # Create query
193 202
     unless ($query) {
194 203
 
195
-        # Create SQL object
196
-        my $builder = $self->query_builder;
197
-        
198 204
         # Create query
205
+        my $builder = $self->query_builder;
199 206
         $query = $builder->build_query($source);
200 207
 
201
-        # Bind
202
-        my $columns = $query->columns;
208
+        # Remove reserved word quote
203 209
         if (my $q = $self->reserved_word_quote) {
204
-            foreach my $column (@$columns) {
205
-                $column =~ s/$q//g;
206
-            }
210
+            $_ =~ s/$q//g for @{$query->columns}
207 211
         }
208 212
 
209
-        # Cache query
210
-        $self->cache_method->($self, $source,
211
-                             {sql     => $query->sql, 
212
-                              columns => $query->columns,
213
-                              tables  => $query->tables})
214
-          if $cache;
213
+        # Save query to cache
214
+        $self->cache_method->(
215
+            $self, $source,
216
+            {
217
+                sql     => $query->sql, 
218
+                columns => $query->columns,
219
+                tables  => $query->tables
220
+            }
221
+        ) if $cache;
215 222
     }
216 223
     
217 224
     # Prepare statement handle
... ...
@@ -230,18 +237,24 @@ sub create_query {
230 237
 
231 238
 sub dbh {
232 239
     my $self = shift;
233
-
240
+    
241
+    # Set
234 242
     if (@_) {
235 243
         $self->{dbh} = $_[0];
236 244
         return $self;
237 245
     }
246
+    
247
+    # Get
238 248
     else {
239 249
         my $pid = $$;
250
+        
251
+        # Get database handle
240 252
         if ($self->pid eq $pid) {
241 253
             return $self->{dbh};
242 254
         }
255
+        
256
+        # Create new database handle in child process
243 257
         else {
244
-            # Create new connection in child process
245 258
             croak "Process is forked in transaction"
246 259
               unless $self->{dbh}->{AutoCommit};
247 260
             $self->pid($pid);
... ...
@@ -257,12 +270,9 @@ our %DELETE_ARGS
257 270
 sub delete {
258 271
     my ($self, %args) = @_;
259 272
 
260
-    # Quote for reserved word
261
-    my $q = $self->reserved_word_quote;
262
-    
263
-    # Check argument names
273
+    # Check arguments
264 274
     foreach my $name (keys %args) {
265
-        croak qq{Argument "$name" is invalid name}
275
+        croak qq{Argument "$name" is wrong name}
266 276
           unless $DELETE_ARGS{$name};
267 277
     }
268 278
     
... ...
@@ -272,39 +282,34 @@ sub delete {
272 282
     my $where            = delete $args{where} || {};
273 283
     my $append           = delete $args{append};
274 284
     my $allow_delete_all = delete $args{allow_delete_all};
285
+    my $query_return     = delete $args{query};
275 286
 
276 287
     # Where
277
-    my $w = $self->_where($where);
278
-    $where = $w->param;
279
-    
280
-    # String where
281
-    my $swhere = "$w";
288
+    $where = $self->_where_to_obj($where);
282 289
     
290
+    # Where clause
291
+    my $where_clause = $where->to_string;
283 292
     croak qq{"where" must be specified}
284
-      if $swhere eq '' && !$allow_delete_all;
293
+      if $where_clause eq '' && !$allow_delete_all;
285 294
 
286
-    # SQL stack
295
+    # Delete statement
287 296
     my @sql;
288
-
289
-    # Delete
290
-    push @sql, "delete from $q$table$q $swhere";
297
+    my $q = $self->reserved_word_quote;
298
+    push @sql, "delete from $q$table$q $where_clause";
291 299
     push @sql, $append if $append;
292
-    
293 300
     my $sql = join(' ', @sql);
294 301
     
295 302
     # Create query
296 303
     my $query = $self->create_query($sql);
297
-    return $query if $args{query};
304
+    return $query if $query_return;
298 305
     
299 306
     # Execute query
300
-    my $ret_val = $self->execute(
307
+    return $self->execute(
301 308
         $query,
302
-        param  => $where,
309
+        param => $where->param,
303 310
         table => $table,
304 311
         %args
305 312
     );
306
-    
307
-    return $ret_val;
308 313
 }
309 314
 
310 315
 sub delete_all { shift->delete(allow_delete_all => 1, @_) }
... ...
@@ -314,56 +319,45 @@ our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
314 319
 sub delete_at {
315 320
     my ($self, %args) = @_;
316 321
     
317
-    # Check argument names
318
-    foreach my $name (keys %args) {
319
-        croak qq{Argument "$name" is invalid name}
320
-          unless $DELETE_AT_ARGS{$name};
321
-    }
322
-    
323
-    # Primary key
322
+    # Arguments
324 323
     my $primary_keys = delete $args{primary_key};
325 324
     $primary_keys = [$primary_keys] unless ref $primary_keys;
325
+    my $where = delete $args{where};
326 326
     
327
-    # Where clause
328
-    my $where = {};
329
-    if (exists $args{where}) {
330
-        my $where_columns = delete $args{where};
331
-        $where_columns = [$where_columns] unless ref $where_columns;
332
-
333
-        croak qq{"where" must be constant value or array reference}
334
-          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
335
-        
336
-        for(my $i = 0; $i < @$primary_keys; $i ++) {
337
-           $where->{$primary_keys->[$i]} = $where_columns->[$i];
338
-        }
327
+    # Check arguments
328
+    foreach my $name (keys %args) {
329
+        croak qq{Argument "$name" is wrong name}
330
+          unless $DELETE_AT_ARGS{$name};
339 331
     }
340 332
     
341
-    if (exists $args{param}) {
342
-        my $param = delete $args{param};
343
-        
333
+    # Where to hash
334
+    my $param = {};
335
+    if ($where) {
336
+        $where = [$where] unless ref $where;
337
+        croak qq{"where" must be constant value or array reference}
338
+          unless ref $where eq 'ARRAY';
344 339
         for(my $i = 0; $i < @$primary_keys; $i ++) {
345
-            delete $param->{$primary_keys->[$i]};
340
+           $param->{$primary_keys->[$i]} = $where->[$i];
346 341
         }
347 342
     }
348 343
     
349
-    return $self->delete(where => $where, %args);
344
+    return $self->delete(where => $param, %args);
350 345
 }
351 346
 
352 347
 sub DESTROY { }
353 348
 
354
-our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
355
-
356 349
 sub create_model {
357 350
     my $self = shift;
358 351
     
352
+    # Arguments
359 353
     my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
360 354
     $args->{dbi} = $self;
361
-    
362 355
     my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
363 356
     my $model_name  = delete $args->{name};
364 357
     my $model_table = delete $args->{table};
365 358
     $model_name ||= $model_table;
366 359
     
360
+    # Create model
367 361
     my $model = $model_class->new($args);
368 362
     $model->name($model_name) unless $model->name;
369 363
     $model->table($model_table) unless $model->table;
... ...
@@ -373,7 +367,7 @@ sub create_model {
373 367
       unless ref $model->filter eq 'ARRAY';
374 368
     $self->apply_filter($model->table, @{$model->filter});
375 369
     
376
-    # Table - Model
370
+    # Associate table with model
377 371
     croak "Table name is duplicated"
378 372
       if exists $self->{_model_from}->{$model->table};
379 373
     $self->{_model_from}->{$model->table} = $model->name;
... ...
@@ -407,44 +401,44 @@ sub each_column {
407 401
     }
408 402
 }
409 403
 
410
-sub execute{
404
+our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
405
+
406
+sub _remove_duplicate_table {
407
+    my ($self, $tables, $main_table) = @_;
408
+    
409
+    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
410
+    delete $tables{$main_table} if $main_table;
411
+    
412
+    return [keys %tables, $main_table ? $main_table : ()];
413
+}
414
+
415
+sub execute {
411 416
     my ($self, $query, %args)  = @_;
412 417
     
413
-    # Quote for reserved word
414
-    my $q = $self->reserved_word_quote;
418
+    # Arguments
419
+    my $params = delete $args{param} || {};
420
+    my $tables = delete $args{table} || [];
421
+    $tables = [$tables] unless ref $tables eq 'ARRAY';
415 422
     
416 423
     # Check argument names
417 424
     foreach my $name (keys %args) {
418
-        croak qq{Argument "$name" is invalid name}
425
+        croak qq{Argument "$name" is wrong name}
419 426
           unless $EXECUTE_ARGS{$name};
420 427
     }
421 428
     
422
-    my $params = $args{param} || {};
423
-    
424
-    # First argument is the soruce of SQL
425
-    $query = $self->create_query($query)
426
-      unless ref $query;
427
-    
428
-    # Applied filter
429
-    my $filter = {};
429
+    # Create query
430
+    $query = $self->create_query($query) unless ref $query;
430 431
     
431
-    my $tables = $query->tables;
432
-    if ($q) {
433
-        foreach my $table (@$tables) {
434
-            $table =~ s/$q//g;
435
-        }
436
-    }
437
-    my $arg_tables = $args{table} || [];
438
-    $arg_tables = [$arg_tables]
439
-      unless ref $arg_tables eq 'ARRAY';
440
-    push @$tables, @$arg_tables;
441
-
442
-    # Organize tables
432
+    # Tables
433
+    unshift @$tables, @{$query->tables};
443 434
     my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
444 435
     my $main_table = pop @$tables;
445
-    delete $table_set{$main_table} if $main_table;
446
-    foreach my $table (keys %table_set) {
447
-        push @$tables, $table;
436
+    $tables = $self->_remove_duplicate_table($tables, $main_table);
437
+    if (my $q = $self->reserved_word_quote) {
438
+        $_ =~ s/$q//g for @$tables;
439
+    }
440
+
441
+    foreach my $table (@$tables) {
448 442
         
449 443
         if (my $dist = $self->{_table_alias}->{$table}) {
450 444
             $self->{filter} ||= {};
... ...
@@ -468,10 +462,9 @@ sub execute{
468 462
             }
469 463
         }
470 464
     }
471
-    
472
-    $tables = [keys %table_set];
473
-    push @$tables, $main_table if $main_table;
474
-    
465
+
466
+    # Filters
467
+    my $filter = {};
475 468
     foreach my $table (@$tables) {
476 469
         next unless $table;
477 470
         $filter = {
... ...
@@ -557,12 +550,12 @@ our %INSERT_ARGS = map { $_ => 1 } @COMMON_ARGS, qw/param append/;
557 550
 sub insert {
558 551
     my ($self, %args) = @_;
559 552
     
560
-    # Quote for reserved word
553
+    # Reserved word quote
561 554
     my $q = $self->reserved_word_quote;
562 555
 
563 556
     # Check argument names
564 557
     foreach my $name (keys %args) {
565
-        croak qq{Argument "$name" is invalid name}
558
+        croak qq{Argument "$name" is wrong name}
566 559
           unless $INSERT_ARGS{$name};
567 560
     }
568 561
     
... ...
@@ -615,7 +608,7 @@ sub insert_at {
615 608
     
616 609
     # Check argument names
617 610
     foreach my $name (keys %args) {
618
-        croak qq{Argument "$name" is invalid name}
611
+        croak qq{Argument "$name" is wrong name}
619 612
           unless $INSERT_AT_ARGS{$name};
620 613
     }
621 614
     
... ...
@@ -865,12 +858,12 @@ our %SELECT_ARGS
865 858
 sub select {
866 859
     my ($self, %args) = @_;
867 860
 
868
-    # Quote for reserved word
861
+    # Reserved word quote
869 862
     my $q = $self->reserved_word_quote;
870 863
     
871 864
     # Check argument names
872 865
     foreach my $name (keys %args) {
873
-        croak qq{Argument "$name" is invalid name}
866
+        croak qq{Argument "$name" is wrong name}
874 867
           unless $SELECT_ARGS{$name};
875 868
     }
876 869
     
... ...
@@ -930,7 +923,7 @@ sub select {
930 923
     unshift @$tables, @{$self->_tables(join(' ', keys %$param) || '')};
931 924
     
932 925
     # Where
933
-    my $w = $self->_where($where);
926
+    my $w = $self->_where_to_obj($where);
934 927
     $param = keys %$param ? $self->merge_param($param, $w->param)
935 928
                          : $w->param;
936 929
     
... ...
@@ -977,7 +970,7 @@ sub select_at {
977 970
     
978 971
     # Check argument names
979 972
     foreach my $name (keys %args) {
980
-        croak qq{Argument "$name" is invalid name}
973
+        croak qq{Argument "$name" is wrong name}
981 974
           unless $SELECT_AT_ARGS{$name};
982 975
     }
983 976
     
... ...
@@ -1035,12 +1028,12 @@ our %UPDATE_ARGS
1035 1028
 sub update {
1036 1029
     my ($self, %args) = @_;
1037 1030
 
1038
-    # Quote for reserved word
1031
+    # Reserved word quote
1039 1032
     my $q = $self->reserved_word_quote;
1040 1033
     
1041 1034
     # Check argument names
1042 1035
     foreach my $name (keys %args) {
1043
-        croak qq{Argument "$name" is invalid name}
1036
+        croak qq{Argument "$name" is wrong name}
1044 1037
           unless $UPDATE_ARGS{$name};
1045 1038
     }
1046 1039
     
... ...
@@ -1067,7 +1060,7 @@ sub update {
1067 1060
     my $update_clause = '{update_param ' . join(' ', @columns) . '}';
1068 1061
 
1069 1062
     # Where
1070
-    my $w = $self->_where($where);
1063
+    my $w = $self->_where_to_obj($where);
1071 1064
     $where = $w->param;
1072 1065
     
1073 1066
     # String where
... ...
@@ -1124,7 +1117,7 @@ sub update_at {
1124 1117
     
1125 1118
     # Check argument names
1126 1119
     foreach my $name (keys %args) {
1127
-        croak qq{Argument "$name" is invalid name}
1120
+        croak qq{Argument "$name" is wrong name}
1128 1121
           unless $UPDATE_AT_ARGS{$name};
1129 1122
     }
1130 1123
     
... ...
@@ -1360,7 +1353,7 @@ sub _push_join {
1360 1353
     }
1361 1354
 }
1362 1355
 
1363
-sub _where {
1356
+sub _where_to_obj {
1364 1357
     my ($self, $where) = @_;
1365 1358
     
1366 1359
     my $w;
... ...
@@ -1684,7 +1677,7 @@ Query builder, default to L<DBIx::Custom::QueryBuilder> object.
1684 1677
      my reserved_word_quote = $dbi->reserved_word_quote;
1685 1678
      $dbi                   = $dbi->reserved_word_quote('"');
1686 1679
 
1687
-Quote for reserved word, default to empty string.
1680
+Reserved word quote, default to empty string.
1688 1681
 
1689 1682
 =head2 C<result_class>
1690 1683
 
+1 -1
t/dbix-custom-core-sqlite.t
... ...
@@ -599,7 +599,7 @@ $dbi->execute($CREATE_TABLE->{0});
599 599
 }
600 600
 
601 601
 eval{$dbi->execute('select * from table1', no_exists => 1)};
602
-like($@, qr/invalid/, "invald SQL");
602
+like($@, qr/name/, "invald SQL");
603 603
 
604 604
 $query = $dbi->create_query('select * from table1 where {= key1}');
605 605
 $dbi->dbh->disconnect;