... | ... |
@@ -1055,29 +1055,6 @@ sub update_at { |
1055 | 1055 |
return $self->update(where => $where_param, %args); |
1056 | 1056 |
} |
1057 | 1057 |
|
1058 |
-sub _create_where_param { |
|
1059 |
- my ($self, $where, $primary_keys) = @_; |
|
1060 |
- |
|
1061 |
- # Create where parameter |
|
1062 |
- my $where_param = {}; |
|
1063 |
- if ($where) { |
|
1064 |
- $where = [$where] unless ref $where; |
|
1065 |
- croak qq{"where" must be constant value or array reference} |
|
1066 |
- . " (" . (caller 1)[3] . ")" |
|
1067 |
- unless !ref $where || ref $where eq 'ARRAY'; |
|
1068 |
- |
|
1069 |
- croak qq{"where" must contain values same count as primary key} |
|
1070 |
- . " (" . (caller 1)[3] . ")" |
|
1071 |
- unless @$primary_keys eq @$where; |
|
1072 |
- |
|
1073 |
- for(my $i = 0; $i < @$primary_keys; $i ++) { |
|
1074 |
- $where_param->{$primary_keys->[$i]} = $where->[$i]; |
|
1075 |
- } |
|
1076 |
- } |
|
1077 |
- |
|
1078 |
- return $where_param; |
|
1079 |
-} |
|
1080 |
- |
|
1081 | 1058 |
sub update_param_tag { |
1082 | 1059 |
my ($self, $param, $opt) = @_; |
1083 | 1060 |
|
... | ... |
@@ -1087,6 +1064,7 @@ sub update_param_tag { |
1087 | 1064 |
my $q = $self->reserved_word_quote; |
1088 | 1065 |
foreach my $column (keys %$param) { |
1089 | 1066 |
croak qq{"$column" is not safety column name} |
1067 |
+ . qq{ (DBIx::Custom::update_param_tag) } |
|
1090 | 1068 |
unless $column =~ /^[$safety\.]+$/; |
1091 | 1069 |
my $column = "$q$column$q"; |
1092 | 1070 |
$column =~ s/\./$q.$q/; |
... | ... |
@@ -1156,12 +1134,35 @@ sub _create_bind_values { |
1156 | 1134 |
return $bind; |
1157 | 1135 |
} |
1158 | 1136 |
|
1137 |
+sub _create_where_param { |
|
1138 |
+ my ($self, $where, $primary_keys) = @_; |
|
1139 |
+ |
|
1140 |
+ # Create where parameter |
|
1141 |
+ my $where_param = {}; |
|
1142 |
+ if ($where) { |
|
1143 |
+ $where = [$where] unless ref $where; |
|
1144 |
+ croak qq{"where" must be constant value or array reference} |
|
1145 |
+ . " (" . (caller 1)[3] . ")" |
|
1146 |
+ unless !ref $where || ref $where eq 'ARRAY'; |
|
1147 |
+ |
|
1148 |
+ croak qq{"where" must contain values same count as primary key} |
|
1149 |
+ . " (" . (caller 1)[3] . ")" |
|
1150 |
+ unless @$primary_keys eq @$where; |
|
1151 |
+ |
|
1152 |
+ for(my $i = 0; $i < @$primary_keys; $i ++) { |
|
1153 |
+ $where_param->{$primary_keys->[$i]} = $where->[$i]; |
|
1154 |
+ } |
|
1155 |
+ } |
|
1156 |
+ |
|
1157 |
+ return $where_param; |
|
1158 |
+} |
|
1159 |
+ |
|
1159 | 1160 |
sub _connect { |
1160 | 1161 |
my $self = shift; |
1161 | 1162 |
|
1162 | 1163 |
# Attributes |
1163 | 1164 |
my $data_source = $self->data_source; |
1164 |
- croak qq{"data_source" must be specified to connect()"} |
|
1165 |
+ croak qq{"data_source" must be specified (DBIx::Custom::dbh)"} |
|
1165 | 1166 |
unless $data_source; |
1166 | 1167 |
my $user = $self->user; |
1167 | 1168 |
my $password = $self->password; |
... | ... |
@@ -1179,7 +1180,7 @@ sub _connect { |
1179 | 1180 |
)}; |
1180 | 1181 |
|
1181 | 1182 |
# Connect error |
1182 |
- croak $@ if $@; |
|
1183 |
+ croak "$@ (DBIx::Custom::dbh)" if $@; |
|
1183 | 1184 |
|
1184 | 1185 |
return $dbh; |
1185 | 1186 |
} |
... | ... |
@@ -1235,13 +1236,15 @@ sub _push_join { |
1235 | 1236 |
if ($join_clause =~ $join_re) { |
1236 | 1237 |
my $table1 = $1; |
1237 | 1238 |
my $table2 = $2; |
1238 |
- croak qq{right side table of "$join_clause" must be uniq} |
|
1239 |
+ croak qq{right side table of "$join_clause" must be unique} |
|
1240 |
+ . qq{ (DBIx::Custom::select)} |
|
1239 | 1241 |
if exists $tree->{$table2}; |
1240 | 1242 |
$tree->{$table2} |
1241 | 1243 |
= {position => $i, parent => $table1, join => $join_clause}; |
1242 | 1244 |
} |
1243 | 1245 |
else { |
1244 |
- croak qq{join "$join_clause" must be two table name}; |
|
1246 |
+ croak qq{join "$join_clause" must be two table name} |
|
1247 |
+ . qq{ (DBIx::Custom::select)}; |
|
1245 | 1248 |
} |
1246 | 1249 |
} |
1247 | 1250 |
|
... | ... |
@@ -1317,8 +1320,9 @@ sub _where_to_obj { |
1317 | 1320 |
} |
1318 | 1321 |
|
1319 | 1322 |
# Check where argument |
1320 |
- croak qq{"where" must be hash reference or DBIx::Custom::Where object} . |
|
1321 |
- qq{or array reference, which contains where clause and paramter} |
|
1323 |
+ croak qq{"where" must be hash reference or DBIx::Custom::Where object} |
|
1324 |
+ . qq{or array reference, which contains where clause and paramter} |
|
1325 |
+ . " (" . (caller(1))[3] . ")" |
|
1322 | 1326 |
unless ref $obj eq 'DBIx::Custom::Where'; |
1323 | 1327 |
|
1324 | 1328 |
return $obj; |
... | ... |
@@ -1328,7 +1328,7 @@ $dbi->method({one => sub { 1 }}); |
1328 | 1328 |
is($dbi->one, 1); |
1329 | 1329 |
|
1330 | 1330 |
eval{DBIx::Custom->connect()}; |
1331 |
-like($@, qr/connect/); |
|
1331 |
+like($@, qr/dbh/); |
|
1332 | 1332 |
|
1333 | 1333 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0}); |
1334 | 1334 |
$dbi->execute($CREATE_TABLE->{0}); |