- added EXPERIMENTAL type() attribute to DBIx:...
...:Custom::Model
| ... | ... |
@@ -1,5 +1,6 @@ |
| 1 | 1 |
0.1663 |
| 2 |
- - added bind_param_option can set bind_param option |
|
| 2 |
+ - added EXPERIMENTAL type() attribute to DBIx::Custom::Model |
|
| 3 |
+ - added EXPERIMENTAL bind_param_option can set bind_param option |
|
| 3 | 4 |
to insert(), update(), delete(), select(), insert_at(), |
| 4 | 5 |
update_at(), delete_at(), select_at(), delete_all(), update_all() |
| 5 | 6 |
0.1662 |
| ... | ... |
@@ -19,7 +19,7 @@ use DBIx::Custom::Tag; |
| 19 | 19 |
use DBIx::Custom::Util; |
| 20 | 20 |
use Encode qw/encode_utf8 decode_utf8/; |
| 21 | 21 |
|
| 22 |
-our @COMMON_ARGS = qw/table query filter bind_param_option/; |
|
| 22 |
+our @COMMON_ARGS = qw/table query filter type/; |
|
| 23 | 23 |
|
| 24 | 24 |
__PACKAGE__->attr( |
| 25 | 25 |
[qw/data_source password pid user/], |
| ... | ... |
@@ -433,15 +433,23 @@ sub execute{
|
| 433 | 433 |
} |
| 434 | 434 |
$filter = {%$filter, %$f};
|
| 435 | 435 |
|
| 436 |
+ # Type |
|
| 437 |
+ my $type = DBIx::Custom::Util::array_to_hash($args{type});
|
|
| 438 |
+ |
|
| 436 | 439 |
# Bind |
| 437 |
- my $bind = $self->_bind($params, $query->columns, $filter); |
|
| 440 |
+ my $bind = $self->_bind($params, $query->columns, $filter, $type); |
|
| 438 | 441 |
|
| 439 | 442 |
# Execute |
| 440 | 443 |
my $sth = $query->sth; |
| 441 | 444 |
my $affected; |
| 442 | 445 |
eval {
|
| 443 | 446 |
for (my $i = 0; $i < @$bind; $i++) {
|
| 444 |
- $sth->bind_param($i + 1, $bind->[$i]); |
|
| 447 |
+ if (my $type = $bind->[$i]->{type}) {
|
|
| 448 |
+ $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);
|
|
| 449 |
+ } |
|
| 450 |
+ else {
|
|
| 451 |
+ $sth->bind_param($i + 1, $bind->[$i]->{value});
|
|
| 452 |
+ } |
|
| 445 | 453 |
} |
| 446 | 454 |
$affected = $sth->execute; |
| 447 | 455 |
}; |
| ... | ... |
@@ -678,6 +686,8 @@ sub include_model {
|
| 678 | 686 |
$table_alias = {%$table_alias, %{$model->table_alias}};
|
| 679 | 687 |
|
| 680 | 688 |
# Table - Model |
| 689 |
+ croak "Table name is duplicated" |
|
| 690 |
+ if exists $self->{_model_from}->{$model->table};
|
|
| 681 | 691 |
$self->{_model_from}->{$model->table} = $model->name;
|
| 682 | 692 |
} |
| 683 | 693 |
|
| ... | ... |
@@ -1163,10 +1173,10 @@ sub where {
|
| 1163 | 1173 |
} |
| 1164 | 1174 |
|
| 1165 | 1175 |
sub _bind {
|
| 1166 |
- my ($self, $params, $columns, $filter) = @_; |
|
| 1176 |
+ my ($self, $params, $columns, $filter, $type) = @_; |
|
| 1167 | 1177 |
|
| 1168 | 1178 |
# bind values |
| 1169 |
- my @bind; |
|
| 1179 |
+ my $bind = []; |
|
| 1170 | 1180 |
|
| 1171 | 1181 |
# Build bind values |
| 1172 | 1182 |
my $count = {};
|
| ... | ... |
@@ -1196,13 +1206,17 @@ sub _bind {
|
| 1196 | 1206 |
# Filter |
| 1197 | 1207 |
my $f = $filter->{$column} || $self->{default_out_filter} || '';
|
| 1198 | 1208 |
|
| 1199 |
- push @bind, $f ? $f->($value) : $value; |
|
| 1209 |
+ # Type |
|
| 1210 |
+ push @$bind, {
|
|
| 1211 |
+ value => $f ? $f->($value) : $value, |
|
| 1212 |
+ type => $type->{$column}
|
|
| 1213 |
+ }; |
|
| 1200 | 1214 |
|
| 1201 | 1215 |
# Count up |
| 1202 | 1216 |
$count->{$column}++;
|
| 1203 | 1217 |
} |
| 1204 | 1218 |
|
| 1205 |
- return \@bind; |
|
| 1219 |
+ return $bind; |
|
| 1206 | 1220 |
} |
| 1207 | 1221 |
|
| 1208 | 1222 |
sub _connect {
|
| ... | ... |
@@ -2403,6 +2417,17 @@ You can check SQL. |
| 2403 | 2417 |
|
| 2404 | 2418 |
my $sql = $query->sql; |
| 2405 | 2419 |
|
| 2420 |
+=item C<type> EXPERIMENTAL |
|
| 2421 |
+ |
|
| 2422 |
+Specify database data type. |
|
| 2423 |
+ |
|
| 2424 |
+ $dbi->select(type => [image => DBI::SQL_BLOB]); |
|
| 2425 |
+ $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]); |
|
| 2426 |
+ |
|
| 2427 |
+This is used to bind paramter by C<bind_param()> of statment handle. |
|
| 2428 |
+ |
|
| 2429 |
+ $sth->bind_param($pos, $value, DBI::SQL_BLOB); |
|
| 2430 |
+ |
|
| 2406 | 2431 |
=back |
| 2407 | 2432 |
|
| 2408 | 2433 |
=head2 C<select_at()> EXPERIMENTAL |
| ... | ... |
@@ -16,6 +16,7 @@ __PACKAGE__->attr( |
| 16 | 16 |
columns => sub { [] },
|
| 17 | 17 |
filter => sub { [] },
|
| 18 | 18 |
join => sub { [] },
|
| 19 |
+ type => sub { [] },
|
|
| 19 | 20 |
primary_key => sub { [] }
|
| 20 | 21 |
); |
| 21 | 22 |
|
| ... | ... |
@@ -39,6 +40,25 @@ sub AUTOLOAD {
|
| 39 | 40 |
} |
| 40 | 41 |
} |
| 41 | 42 |
|
| 43 |
+my @methods = qw/insert insert_at update update_at update_all |
|
| 44 |
+ delete delete_at delete_all select select_at/; |
|
| 45 |
+foreach my $method (@methods) {
|
|
| 46 |
+ |
|
| 47 |
+ my $code = sub {
|
|
| 48 |
+ my $self = shift; |
|
| 49 |
+ |
|
| 50 |
+ my @args = (table => $self->table, type => $self->type); |
|
| 51 |
+ push @args, (primary_key => $self->primary_key) if $method =~ /_at$/; |
|
| 52 |
+ push @args, (join => $self->join) if $method =~ /^select/; |
|
| 53 |
+ |
|
| 54 |
+ $self->dbi->$method(@args, @_); |
|
| 55 |
+ }; |
|
| 56 |
+ |
|
| 57 |
+ no strict 'refs'; |
|
| 58 |
+ my $class = __PACKAGE__; |
|
| 59 |
+ *{"${class}::$method"} = $code;
|
|
| 60 |
+} |
|
| 61 |
+ |
|
| 42 | 62 |
sub column {
|
| 43 | 63 |
my ($self, $table, $columns) = @_; |
| 44 | 64 |
|
| ... | ... |
@@ -56,43 +76,8 @@ sub column {
|
| 56 | 76 |
return $self->dbi->column($table, $columns); |
| 57 | 77 |
} |
| 58 | 78 |
|
| 59 |
-sub delete {
|
|
| 60 |
- my $self = shift; |
|
| 61 |
- $self->dbi->delete(table => $self->table, @_); |
|
| 62 |
-} |
|
| 63 |
- |
|
| 64 |
-sub delete_all {
|
|
| 65 |
- my $self = shift; |
|
| 66 |
- $self->dbi->delete_all(table => $self->table, @_); |
|
| 67 |
-} |
|
| 68 |
- |
|
| 69 |
-sub delete_at {
|
|
| 70 |
- my $self = shift; |
|
| 71 |
- |
|
| 72 |
- return $self->dbi->delete_at( |
|
| 73 |
- table => $self->table, |
|
| 74 |
- primary_key => $self->primary_key, |
|
| 75 |
- @_ |
|
| 76 |
- ); |
|
| 77 |
-} |
|
| 78 |
- |
|
| 79 | 79 |
sub DESTROY { }
|
| 80 | 80 |
|
| 81 |
-sub insert {
|
|
| 82 |
- my $self = shift; |
|
| 83 |
- $self->dbi->insert(table => $self->table, @_); |
|
| 84 |
-} |
|
| 85 |
- |
|
| 86 |
-sub insert_at {
|
|
| 87 |
- my $self = shift; |
|
| 88 |
- |
|
| 89 |
- return $self->dbi->insert_at( |
|
| 90 |
- table => $self->table, |
|
| 91 |
- primary_key => $self->primary_key, |
|
| 92 |
- @_ |
|
| 93 |
- ); |
|
| 94 |
-} |
|
| 95 |
- |
|
| 96 | 81 |
sub mycolumn {
|
| 97 | 82 |
my $self = shift; |
| 98 | 83 |
my $table = shift unless ref $_[0]; |
| ... | ... |
@@ -104,46 +89,6 @@ sub mycolumn {
|
| 104 | 89 |
return $self->dbi->mycolumn($table, $columns); |
| 105 | 90 |
} |
| 106 | 91 |
|
| 107 |
-sub select {
|
|
| 108 |
- my $self = shift; |
|
| 109 |
- $self->dbi->select( |
|
| 110 |
- table => $self->table, |
|
| 111 |
- join => $self->join, |
|
| 112 |
- @_ |
|
| 113 |
- ); |
|
| 114 |
-} |
|
| 115 |
- |
|
| 116 |
-sub select_at {
|
|
| 117 |
- my $self = shift; |
|
| 118 |
- |
|
| 119 |
- return $self->dbi->select_at( |
|
| 120 |
- table => $self->table, |
|
| 121 |
- primary_key => $self->primary_key, |
|
| 122 |
- join => $self->join, |
|
| 123 |
- @_ |
|
| 124 |
- ); |
|
| 125 |
-} |
|
| 126 |
- |
|
| 127 |
-sub update {
|
|
| 128 |
- my $self = shift; |
|
| 129 |
- $self->dbi->update(table => $self->table, @_) |
|
| 130 |
-} |
|
| 131 |
- |
|
| 132 |
-sub update_all {
|
|
| 133 |
- my $self = shift; |
|
| 134 |
- $self->dbi->update_all(table => $self->table, @_); |
|
| 135 |
-} |
|
| 136 |
- |
|
| 137 |
-sub update_at {
|
|
| 138 |
- my $self = shift; |
|
| 139 |
- |
|
| 140 |
- return $self->dbi->update_at( |
|
| 141 |
- table => $self->table, |
|
| 142 |
- primary_key => $self->primary_key, |
|
| 143 |
- @_ |
|
| 144 |
- ); |
|
| 145 |
-} |
|
| 146 |
- |
|
| 147 | 92 |
1; |
| 148 | 93 |
|
| 149 | 94 |
=head1 NAME |
| ... | ... |
@@ -204,6 +149,15 @@ Generally, this is automatically set from class name. |
| 204 | 149 |
Foreign key, this is used as C<primary_key> of C<insert_at>,C<update_at()>, |
| 205 | 150 |
C<delete_at()>,C<select_at()>. |
| 206 | 151 |
|
| 152 |
+=head2 C<type> |
|
| 153 |
+ |
|
| 154 |
+ my $type = $model->type; |
|
| 155 |
+ $model = $model->type(['image' => DBI::SQL_BLOB]); |
|
| 156 |
+ |
|
| 157 |
+Database data type, this is used as type optioon of C<insert()>, C<insert_at()>, |
|
| 158 |
+C<update()>, C<update_at()>, C<update_all>, C<delete()>, C<delete_all()>, |
|
| 159 |
+C<select(), C<select_at()> |
|
| 160 |
+ |
|
| 207 | 161 |
=head2 C<view> |
| 208 | 162 |
|
| 209 | 163 |
my $view = $model->view; |
| ... | ... |
@@ -265,7 +219,7 @@ you don't have to specify C<table> option. |
| 265 | 219 |
Same as C<insert_at()> of L<DBIx::Custom> except that |
| 266 | 220 |
you don't have to specify C<table> and C<primary_key> option. |
| 267 | 221 |
|
| 268 |
-=head2 C<mycolumn> EXPERIMENTAL |
|
| 222 |
+=head2 C<mycolumn> |
|
| 269 | 223 |
|
| 270 | 224 |
my $column = $self->mycolumn; |
| 271 | 225 |
my $column = $self->mycolumn(book => ['author', 'title']); |
| ... | ... |
@@ -1403,11 +1403,13 @@ is_deeply($model->list->fetch_hash_all, [{name => 'a'}], 'basic');
|
| 1403 | 1403 |
} |
| 1404 | 1404 |
$dbi = MyDBI5->connect($NEW_ARGS->{0});
|
| 1405 | 1405 |
$dbi->execute("create table company (name)");
|
| 1406 |
+$dbi->execute("create table table1 (key1)");
|
|
| 1406 | 1407 |
$model = $dbi->model('company');
|
| 1407 | 1408 |
$model->insert({name => 'a'});
|
| 1408 | 1409 |
is_deeply($model->list->fetch_hash_all, [{name => 'a'}], 'include all model');
|
| 1410 |
+$dbi->insert(table => 'table1', param => {key1 => 1});
|
|
| 1409 | 1411 |
$model = $dbi->model('book');
|
| 1410 |
-is_deeply($model->list->fetch_hash_all, [{name => 'a'}], 'include all model');
|
|
| 1412 |
+is_deeply($model->list->fetch_hash_all, [{key1 => 1}], 'include all model');
|
|
| 1411 | 1413 |
|
| 1412 | 1414 |
test 'primary_key'; |
| 1413 | 1415 |
use MyDBI1; |
| ... | ... |
@@ -1602,13 +1604,15 @@ test 'model delete_at'; |
| 1602 | 1604 |
} |
| 1603 | 1605 |
$dbi = MyDBI6->connect($NEW_ARGS->{0});
|
| 1604 | 1606 |
$dbi->execute($CREATE_TABLE->{1});
|
| 1607 |
+$dbi->execute("create table table2 (key1, key2, key3)");
|
|
| 1608 |
+$dbi->execute("create table table3 (key1, key2, key3)");
|
|
| 1605 | 1609 |
$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
|
| 1606 | 1610 |
$dbi->model('table1')->delete_at(where => [1, 2]);
|
| 1607 | 1611 |
is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []); |
| 1608 |
-$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
|
|
| 1612 |
+$dbi->insert(table => 'table2', param => {key1 => 1, key2 => 2, key3 => 3});
|
|
| 1609 | 1613 |
$dbi->model('table1_1')->delete_at(where => [1, 2]);
|
| 1610 | 1614 |
is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []); |
| 1611 |
-$dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2, key3 => 3});
|
|
| 1615 |
+$dbi->insert(table => 'table3', param => {key1 => 1, key2 => 2, key3 => 3});
|
|
| 1612 | 1616 |
$dbi->model('table1_3')->delete_at(where => [1, 2]);
|
| 1613 | 1617 |
is_deeply($dbi->select(table => 'table1')->fetch_hash_all, []); |
| 1614 | 1618 |
|
| ... | ... |
@@ -1873,3 +1877,28 @@ $result = $model->select( |
| 1873 | 1877 |
is_deeply($result->fetch_hash_first, |
| 1874 | 1878 |
{table2_alias__key1 => 1, table2_alias__key3 => 48});
|
| 1875 | 1879 |
|
| 1880 |
+test 'type() option'; |
|
| 1881 |
+$dbi = DBIx::Custom->connect( |
|
| 1882 |
+ data_source => 'dbi:SQLite:dbname=:memory:', |
|
| 1883 |
+ dbi_option => {
|
|
| 1884 |
+ $DBD::SQLite::VERSION > 1.26 ? (sqlite_unicode => 1) : (unicode => 1) |
|
| 1885 |
+ } |
|
| 1886 |
+); |
|
| 1887 |
+my $binary = pack("I3", 1, 2, 3);
|
|
| 1888 |
+$dbi->execute('create table table1(key1, key2)');
|
|
| 1889 |
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [key1 => DBI::SQL_BLOB]);
|
|
| 1890 |
+$result = $dbi->select(table => 'table1'); |
|
| 1891 |
+$row = $result->fetch_hash_first; |
|
| 1892 |
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
|
|
| 1893 |
+$result = $dbi->execute('select length(key1) as key1_length from table1');
|
|
| 1894 |
+$row = $result->fetch_hash_first; |
|
| 1895 |
+is($row->{key1_length}, length $binary);
|
|
| 1896 |
+ |
|
| 1897 |
+$dbi->insert(table => 'table1', param => {key1 => $binary, key2 => 'あ'}, type => [['key1'] => DBI::SQL_BLOB]);
|
|
| 1898 |
+$result = $dbi->select(table => 'table1'); |
|
| 1899 |
+$row = $result->fetch_hash_first; |
|
| 1900 |
+is_deeply($row, {key1 => $binary, key2 => 'あ'}, "basic");
|
|
| 1901 |
+$result = $dbi->execute('select length(key1) as key1_length from table1');
|
|
| 1902 |
+$row = $result->fetch_hash_first; |
|
| 1903 |
+is($row->{key1_length}, length $binary);
|
|
| 1904 |
+ |
| ... | ... |
@@ -2,7 +2,7 @@ package MyModel4::book; |
| 2 | 2 |
|
| 3 | 3 |
use base 'MyModel4'; |
| 4 | 4 |
|
| 5 |
-sub table { 'company' }
|
|
| 5 |
+sub table { 'table1' }
|
|
| 6 | 6 |
|
| 7 | 7 |
sub list { shift->select }
|
| 8 | 8 |
|
| ... | ... |
@@ -5,7 +5,7 @@ use warnings; |
| 5 | 5 |
|
| 6 | 6 |
use base 'MyModel5'; |
| 7 | 7 |
|
| 8 |
-__PACKAGE__->attr(table => 'table1'); |
|
| 8 |
+__PACKAGE__->attr(table => 'table2'); |
|
| 9 | 9 |
|
| 10 | 10 |
__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
|
| 11 | 11 |
|
| ... | ... |
@@ -6,8 +6,8 @@ use warnings; |
| 6 | 6 |
use base 'MyModel5'; |
| 7 | 7 |
|
| 8 | 8 |
__PACKAGE__->attr(name => 'table1_3'); |
| 9 |
-__PACKAGE__->attr(table => 'table1'); |
|
| 9 |
+__PACKAGE__->attr(table => 'table3'); |
|
| 10 | 10 |
|
| 11 | 11 |
__PACKAGE__->attr('primary_key' => sub { ['key1', 'key2'] });
|
| 12 | 12 |
|
| 13 |
-1; |
|
| 13 |
+1; |