Showing 1 changed files with 64 additions and 89 deletions
+64 -89
lib/DBIx/Custom.pm
... ...
@@ -330,18 +330,11 @@ sub delete_at {
330 330
           unless $DELETE_AT_ARGS{$name};
331 331
     }
332 332
     
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';
339
-        for(my $i = 0; $i < @$primary_keys; $i ++) {
340
-           $param->{$primary_keys->[$i]} = $where->[$i];
341
-        }
342
-    }
333
+    # Create where parameter
334
+    my $where_param = $self->_create_where_param($where, $primary_keys);
335
+
343 336
     
344
-    return $self->delete(where => $param, %args);
337
+    return $self->delete(where => $where_param, %args);
345 338
 }
346 339
 
347 340
 sub DESTROY { }
... ...
@@ -603,16 +596,8 @@ sub insert_at {
603 596
           unless $INSERT_AT_ARGS{$name};
604 597
     }
605 598
     
606
-    # Where
607
-    my $where_param = {};
608
-    if ($where) {
609
-        $where = [$where] unless ref $where;
610
-        croak qq{"where" must be constant value or array reference}
611
-          unless !ref $where || ref $where eq 'ARRAY';
612
-        for(my $i = 0; $i < @$primary_keys; $i ++) {
613
-           $where_param->{$primary_keys->[$i]} = $where->[$i];
614
-        }
615
-    }
599
+    # Create where parameter
600
+    my $where_param = $self->_create_where_param($where, $primary_keys);
616 601
     $param = $self->merge_param($where_param, $param);
617 602
     
618 603
     return $self->insert(param => $param, %args);
... ...
@@ -951,16 +936,8 @@ sub select_at {
951 936
     croak qq{"table" option must be specified} unless $args{table};
952 937
     my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
953 938
     
954
-    # Where
955
-    my $where_param = {};
956
-    if ($where) {
957
-        croak qq{"where" must be constant value or array reference}
958
-          unless !ref $where || ref $where eq 'ARRAY';
959
-        $where = [$where] unless ref $where;
960
-        for(my $i = 0; $i < @$primary_keys; $i ++) {
961
-           $where_param->{$table . '.' . $primary_keys->[$i]} = $where->[$i];
962
-        }
963
-    }
939
+    # Create where parameter
940
+    my $where_param = $self->_create_where_param($where, $primary_keys);
964 941
     
965 942
     return $self->select(where => $where_param, %args);
966 943
 }
... ...
@@ -1054,71 +1031,66 @@ our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1054 1031
 sub update_at {
1055 1032
     my ($self, %args) = @_;
1056 1033
     
1057
-    # Check argument names
1034
+    # Arguments
1035
+    my $primary_keys = delete $args{primary_key};
1036
+    $primary_keys = [$primary_keys] unless ref $primary_keys;
1037
+    my $where = delete $args{where};
1038
+    
1039
+
1040
+    # Check arguments
1058 1041
     foreach my $name (keys %args) {
1059 1042
         croak qq{Argument "$name" is wrong name}
1060 1043
           unless $UPDATE_AT_ARGS{$name};
1061 1044
     }
1062 1045
     
1063
-    # Primary key
1064
-    my $primary_keys = delete $args{primary_key};
1065
-    $primary_keys = [$primary_keys] unless ref $primary_keys;
1066
-    
1067
-    # Where clause
1068
-    my $where = {};
1069
-    my $param = {};
1046
+    # Create where parameter
1047
+    my $where_param = $self->_create_where_param($where, $primary_keys);
1070 1048
     
1071
-    if (exists $args{where}) {
1072
-        my $where_columns = delete $args{where};
1073
-        $where_columns = [$where_columns] unless ref $where_columns;
1049
+    return $self->update(where => $where_param, %args);
1050
+}
1074 1051
 
1075
-        croak qq{"where" must be constant value or array reference}
1076
-          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
1077
-        
1078
-        for(my $i = 0; $i < @$primary_keys; $i ++) {
1079
-           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1080
-        }
1081
-    }
1052
+sub _create_where_param {
1053
+    my ($self, $where, $primary_keys) = @_;
1082 1054
     
1083
-    if (exists $args{param}) {
1084
-        $param = delete $args{param};
1055
+    # Create where parameter
1056
+    my $where_param = {};
1057
+    if ($where) {
1058
+        $where = [$where] unless ref $where;
1059
+        croak qq{"where" must be constant value or array reference}
1060
+          unless !ref $where || ref $where eq 'ARRAY';
1085 1061
         for(my $i = 0; $i < @$primary_keys; $i ++) {
1086
-            delete $param->{$primary_keys->[$i]};
1062
+           $where_param->{$primary_keys->[$i]} = $where->[$i];
1087 1063
         }
1088 1064
     }
1089 1065
     
1090
-    return $self->update(where => $where, param => $param, %args);
1066
+    return $where_param;
1091 1067
 }
1092 1068
 
1093 1069
 sub update_param_tag {
1094 1070
     my ($self, $param, $opt) = @_;
1095 1071
     
1096
-    # Insert parameter tag
1072
+    # Create update parameter tag
1097 1073
     my @params;
1098
-    
1099 1074
     my $safety = $self->safety_character;
1100 1075
     my $q = $self->reserved_word_quote;
1101
-    
1102 1076
     foreach my $column (keys %$param) {
1103 1077
         croak qq{"$column" is not safety column name}
1104 1078
           unless $column =~ /^[$safety\.]+$/;
1105
-        
1106
-        my $c = "$q$column$q";
1107
-        $c =~ s/\./$q.$q/;
1108
-        
1109
-        push @params, "$c = {? $c}";
1079
+        my $column = "$q$column$q";
1080
+        $column =~ s/\./$q.$q/;
1081
+        push @params, "$column = {? $column}";
1110 1082
     }
1083
+    my $tag;
1084
+    $tag .= 'set ' unless $opt->{no_set};
1085
+    $tag .= join(', ', @params);
1111 1086
     
1112
-    my $clause;
1113
-    $clause .= 'set ' unless $opt->{no_set};
1114
-    $clause .= join(', ', @params);
1115
-    
1116
-    return $clause;
1087
+    return $tag;
1117 1088
 }
1118 1089
 
1119 1090
 sub where {
1120 1091
     my $self = shift;
1121
-
1092
+    
1093
+    # Create where
1122 1094
     return DBIx::Custom::Where->new(
1123 1095
         query_builder => $self->query_builder,
1124 1096
         safety_character => $self->safety_character,
... ...
@@ -1130,10 +1102,8 @@ sub where {
1130 1102
 sub _create_bind_values {
1131 1103
     my ($self, $params, $columns, $filter, $type) = @_;
1132 1104
     
1133
-    # bind values
1105
+    # Create bind values
1134 1106
     my $bind = [];
1135
-    
1136
-    # Build bind values
1137 1107
     my $count = {};
1138 1108
     my $not_exists = {};
1139 1109
     foreach my $column (@$columns) {
... ...
@@ -1204,6 +1174,8 @@ sub _connect {
1204 1174
 
1205 1175
 sub _croak {
1206 1176
     my ($self, $error, $append) = @_;
1177
+    
1178
+    # Append
1207 1179
     $append ||= "";
1208 1180
     
1209 1181
     # Verbose
... ...
@@ -1216,7 +1188,6 @@ sub _croak {
1216 1188
         my $at_pos = rindex($error, ' at ');
1217 1189
         $error = substr($error, 0, $at_pos);
1218 1190
         $error =~ s/\s+$//;
1219
-        
1220 1191
         croak "$error$append";
1221 1192
     }
1222 1193
 }
... ...
@@ -1224,8 +1195,8 @@ sub _croak {
1224 1195
 sub _need_tables {
1225 1196
     my ($self, $tree, $need_tables, $tables) = @_;
1226 1197
     
1198
+    # Get needed tables
1227 1199
     foreach my $table (@$tables) {
1228
-        
1229 1200
         if ($tree->{$table}) {
1230 1201
             $need_tables->{$table} = 1;
1231 1202
             $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
... ...
@@ -1236,26 +1207,24 @@ sub _need_tables {
1236 1207
 sub _push_join {
1237 1208
     my ($self, $sql, $join, $join_tables) = @_;
1238 1209
     
1210
+    # No join
1239 1211
     return unless @$join;
1240 1212
     
1241
-    my $q = $self->reserved_word_quote;
1242
-    
1213
+    # Push join clause
1243 1214
     my $tree = {};
1244
-    
1215
+    my $q = $self->reserved_word_quote;
1245 1216
     for (my $i = 0; $i < @$join; $i++) {
1246 1217
         
1218
+        # Search table in join clause
1247 1219
         my $join_clause = $join->[$i];
1248 1220
         my $q_re = quotemeta($q);
1249 1221
         my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1250 1222
                          : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
1251 1223
         if ($join_clause =~ $join_re) {
1252
-            
1253 1224
             my $table1 = $1;
1254 1225
             my $table2 = $2;
1255
-            
1256 1226
             croak qq{right side table of "$join_clause" must be uniq}
1257 1227
               if exists $tree->{$table2};
1258
-            
1259 1228
             $tree->{$table2}
1260 1229
               = {position => $i, parent => $table1, join => $join_clause};
1261 1230
         }
... ...
@@ -1264,11 +1233,12 @@ sub _push_join {
1264 1233
         }
1265 1234
     }
1266 1235
     
1236
+    # Search need tables
1267 1237
     my $need_tables = {};
1268 1238
     $self->_need_tables($tree, $need_tables, $join_tables);
1269
-    
1270 1239
     my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
1271
-
1240
+    
1241
+    # Add join clause
1272 1242
     foreach my $need_table (@need_tables) {
1273 1243
         push @$sql, $tree->{$need_table}{join};
1274 1244
     }
... ...
@@ -1287,12 +1257,11 @@ sub _remove_duplicate_table {
1287 1257
 sub _search_tables {
1288 1258
     my ($self, $source) = @_;
1289 1259
     
1260
+    # Search tables
1290 1261
     my $tables = [];
1291
-    
1292 1262
     my $safety_character = $self->safety_character;
1293 1263
     my $q = $self->reserved_word_quote;
1294 1264
     my $q_re = quotemeta($q);
1295
-    
1296 1265
     my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1297 1266
                       : qr/\b([$safety_character]+)\./;
1298 1267
     while ($source =~ /$table_re/g) {
... ...
@@ -1305,7 +1274,9 @@ sub _search_tables {
1305 1274
 sub _where_to_obj {
1306 1275
     my ($self, $where) = @_;
1307 1276
     
1308
-    my $w;
1277
+    my $obj;
1278
+    
1279
+    # Hash
1309 1280
     if (ref $where eq 'HASH') {
1310 1281
         my $clause = ['and'];
1311 1282
         my $q = $self->reserved_word_quote;
... ...
@@ -1314,27 +1285,31 @@ sub _where_to_obj {
1314 1285
             $column =~ s/\./$q.$q/;
1315 1286
             push @$clause, "{= $column}" for keys %$where;
1316 1287
         }
1317
-        
1318
-        $w = $self->where(clause => $clause, param => $where);
1288
+        $obj = $self->where(clause => $clause, param => $where);
1319 1289
     }
1290
+    
1291
+    # DBIx::Custom::Where object
1320 1292
     elsif (ref $where eq 'DBIx::Custom::Where') {
1321
-        $w = $where;
1293
+        $obj = $where;
1322 1294
     }
1295
+    
1296
+    # Array(DEPRECATED!)
1323 1297
     elsif (ref $where eq 'ARRAY') {
1324 1298
         warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1325 1299
              "use \$dbi->select(where => \$dbi->where(clause => " .
1326 1300
              "CLAUSE, param => PARAMETER));";
1327
-        $w = $self->where(
1301
+        $obj = $self->where(
1328 1302
             clause => $where->[0],
1329 1303
             param  => $where->[1]
1330 1304
         );
1331 1305
     }
1332 1306
     
1307
+    # Check where argument
1333 1308
     croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1334 1309
           qq{or array reference, which contains where clause and paramter}
1335
-      unless ref $w eq 'DBIx::Custom::Where';
1310
+      unless ref $obj eq 'DBIx::Custom::Where';
1336 1311
     
1337
-    return $w;
1312
+    return $obj;
1338 1313
 }
1339 1314
 
1340 1315
 # DEPRECATED!