added experimental DBIx::Custom::Model and DBIx::Custom...
...::Table
| ... | ... |
@@ -1,3 +1,5 @@ |
| 1 |
+0.1625 |
|
| 2 |
+ added experimental DBIx::Custom::Model and DBIx::Custom::Table |
|
| 1 | 3 |
0.1624 |
| 2 | 4 |
added experimental iterate_all_columns method. |
| 3 | 5 |
0.1623 |
| ... | ... |
@@ -1,6 +1,6 @@ |
| 1 | 1 |
package DBIx::Custom; |
| 2 | 2 |
|
| 3 |
-our $VERSION = '0.1624'; |
|
| 3 |
+our $VERSION = '0.1625'; |
|
| 4 | 4 |
|
| 5 | 5 |
use 5.008001; |
| 6 | 6 |
use strict; |
| ... | ... |
@@ -13,6 +13,7 @@ use DBI; |
| 13 | 13 |
use DBIx::Custom::Result; |
| 14 | 14 |
use DBIx::Custom::Query; |
| 15 | 15 |
use DBIx::Custom::QueryBuilder; |
| 16 |
+use DBIx::Custom::Model; |
|
| 16 | 17 |
use Encode qw/encode_utf8 decode_utf8/; |
| 17 | 18 |
|
| 18 | 19 |
__PACKAGE__->attr([qw/data_source dbh |
| ... | ... |
@@ -154,13 +155,31 @@ sub helper {
|
| 154 | 155 |
sub connect {
|
| 155 | 156 |
my $proto = shift; |
| 156 | 157 |
|
| 158 |
+ my $self; |
|
| 157 | 159 |
# Create |
| 158 |
- my $self = ref $proto ? $proto : $proto->new(@_); |
|
| 160 |
+ if (my $class = ref $proto) {
|
|
| 161 |
+ my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
|
|
| 162 |
+ $self = $proto; |
|
| 163 |
+ |
|
| 164 |
+ foreach my $attr (keys %$args) {
|
|
| 165 |
+ $self->{$attr} = $args->{$attr};
|
|
| 166 |
+ } |
|
| 167 |
+ |
|
| 168 |
+ # Check attribute names |
|
| 169 |
+ my @attrs = keys %$self; |
|
| 170 |
+ foreach my $attr (@attrs) {
|
|
| 171 |
+ croak qq{"$attr" is invalid attribute name}
|
|
| 172 |
+ unless $self->can($attr); |
|
| 173 |
+ } |
|
| 174 |
+ } |
|
| 175 |
+ else {
|
|
| 176 |
+ $self = $proto->new(@_); |
|
| 177 |
+ } |
|
| 159 | 178 |
|
| 160 | 179 |
# Information |
| 161 | 180 |
my $data_source = $self->data_source; |
| 162 | 181 |
|
| 163 |
- croak qq{"data_source" must be specfied to connect method"}
|
|
| 182 |
+ croak qq{"data_source" must be specified to connect method"}
|
|
| 164 | 183 |
unless $data_source; |
| 165 | 184 |
|
| 166 | 185 |
my $user = $self->user; |
| ... | ... |
@@ -551,7 +570,7 @@ sub select {
|
| 551 | 570 |
|
| 552 | 571 |
# Where clause |
| 553 | 572 |
my $param; |
| 554 |
- if (ref $where eq 'HASH') {
|
|
| 573 |
+ if (ref $where eq 'HASH' && keys %$where) {
|
|
| 555 | 574 |
$param = $where; |
| 556 | 575 |
$source .= 'where (';
|
| 557 | 576 |
foreach my $where_key (keys %$where) {
|
| ... | ... |
@@ -0,0 +1,62 @@ |
| 1 |
+package DBIx::Custom::Model; |
|
| 2 |
+ |
|
| 3 |
+use strict; |
|
| 4 |
+use warnings; |
|
| 5 |
+ |
|
| 6 |
+use base 'Object::Simple'; |
|
| 7 |
+ |
|
| 8 |
+use Carp 'croak'; |
|
| 9 |
+use DBIx::Custom::Table; |
|
| 10 |
+ |
|
| 11 |
+__PACKAGE__->attr(dbi => sub { DBIx::Custom->new });
|
|
| 12 |
+ |
|
| 13 |
+sub table {
|
|
| 14 |
+ my ($self, $table) = @_; |
|
| 15 |
+ |
|
| 16 |
+ $self->{tables}{$table}
|
|
| 17 |
+ = DBIx::Custom::Table->new(name => $table, dbi => $self->dbi) |
|
| 18 |
+ unless defined $self->{tables}{$table};
|
|
| 19 |
+ |
|
| 20 |
+ return $self->{tables}{$table};
|
|
| 21 |
+} |
|
| 22 |
+ |
|
| 23 |
+1; |
|
| 24 |
+ |
|
| 25 |
+=head1 NAME |
|
| 26 |
+ |
|
| 27 |
+DBIx::Custom::Model - Table class(experimental) |
|
| 28 |
+ |
|
| 29 |
+=head1 SYNOPSIS |
|
| 30 |
+ |
|
| 31 |
+use MyModel; |
|
| 32 |
+ |
|
| 33 |
+use base 'DBIx::Custom::Model'; |
|
| 34 |
+ |
|
| 35 |
+sub new {
|
|
| 36 |
+ my $self = shift->SUPER::new(@_); |
|
| 37 |
+ |
|
| 38 |
+ $self->table('books')->helper(
|
|
| 39 |
+ insert_multi => sub {
|
|
| 40 |
+ my $self = shift; |
|
| 41 |
+ |
|
| 42 |
+ my $dbi = $self->dbi; |
|
| 43 |
+ |
|
| 44 |
+ # ... |
|
| 45 |
+ |
|
| 46 |
+ } |
|
| 47 |
+ ); |
|
| 48 |
+ |
|
| 49 |
+ return $self; |
|
| 50 |
+} |
|
| 51 |
+ |
|
| 52 |
+=head1 METHODS |
|
| 53 |
+ |
|
| 54 |
+L<DBIx::Custom> inherits all methods from L<Object::Simple> |
|
| 55 |
+and implements the following new ones. |
|
| 56 |
+ |
|
| 57 |
+=head2 C<table> |
|
| 58 |
+ |
|
| 59 |
+ my $table = $model->table('books');
|
|
| 60 |
+ |
|
| 61 |
+Create a table object if not exists or get it. |
|
| 62 |
+ |
| ... | ... |
@@ -0,0 +1,207 @@ |
| 1 |
+package DBIx::Custom::Table; |
|
| 2 |
+ |
|
| 3 |
+use strict; |
|
| 4 |
+use warnings; |
|
| 5 |
+ |
|
| 6 |
+use base 'Object::Simple'; |
|
| 7 |
+ |
|
| 8 |
+use Carp 'croak'; |
|
| 9 |
+ |
|
| 10 |
+__PACKAGE__->attr(['dbi', 'name']); |
|
| 11 |
+ |
|
| 12 |
+sub new {
|
|
| 13 |
+ my $self = shift->SUPER::new(@_); |
|
| 14 |
+ |
|
| 15 |
+ my $insert = sub {
|
|
| 16 |
+ my $self = shift; |
|
| 17 |
+ |
|
| 18 |
+ return $self->dbi->insert(table => $self->name, param => shift); |
|
| 19 |
+ }; |
|
| 20 |
+ |
|
| 21 |
+ my $update = sub {
|
|
| 22 |
+ my $self = shift; |
|
| 23 |
+ |
|
| 24 |
+ return $self->dbi->update(table => $self->name, param => shift, |
|
| 25 |
+ where => shift); |
|
| 26 |
+ }; |
|
| 27 |
+ |
|
| 28 |
+ my $update_all = sub {
|
|
| 29 |
+ my $self = shift; |
|
| 30 |
+ |
|
| 31 |
+ return $self->dbi->update_all(table => $self->name, param => shift); |
|
| 32 |
+ }; |
|
| 33 |
+ |
|
| 34 |
+ my $delete = sub {
|
|
| 35 |
+ my $self = shift; |
|
| 36 |
+ |
|
| 37 |
+ return $self->dbi->delete(table => $self->name, where => shift); |
|
| 38 |
+ }; |
|
| 39 |
+ |
|
| 40 |
+ my $delete_all = sub {
|
|
| 41 |
+ my $self = shift; |
|
| 42 |
+ |
|
| 43 |
+ return $self->dbi->delete_all(table => $self->name); |
|
| 44 |
+ }; |
|
| 45 |
+ |
|
| 46 |
+ my $select = sub {
|
|
| 47 |
+ my $self = shift; |
|
| 48 |
+ |
|
| 49 |
+ my $where = {};
|
|
| 50 |
+ my $column = ['*']; |
|
| 51 |
+ my $append = ''; |
|
| 52 |
+ |
|
| 53 |
+ foreach my $arg (@_) {
|
|
| 54 |
+ my $type = ref $arg; |
|
| 55 |
+ |
|
| 56 |
+ if ($type eq 'ARRAY') {
|
|
| 57 |
+ $column = $arg; |
|
| 58 |
+ } |
|
| 59 |
+ elsif ($type eq 'HASH') {
|
|
| 60 |
+ $where = $arg; |
|
| 61 |
+ } |
|
| 62 |
+ else {
|
|
| 63 |
+ $append = $arg; |
|
| 64 |
+ } |
|
| 65 |
+ } |
|
| 66 |
+ |
|
| 67 |
+ return $self->dbi->select( |
|
| 68 |
+ table => $self->name, |
|
| 69 |
+ where => $where, |
|
| 70 |
+ column => $column, |
|
| 71 |
+ append => $append |
|
| 72 |
+ ); |
|
| 73 |
+ }; |
|
| 74 |
+ |
|
| 75 |
+ $self->helper( |
|
| 76 |
+ insert => $insert, |
|
| 77 |
+ insert_simple => $insert, |
|
| 78 |
+ update => $update, |
|
| 79 |
+ update_simple => $update, |
|
| 80 |
+ update_all => $update_all, |
|
| 81 |
+ update_all_simple => $update_all, |
|
| 82 |
+ delete => $delete, |
|
| 83 |
+ delete_simple => $delete, |
|
| 84 |
+ delete_all => $delete_all, |
|
| 85 |
+ delete_all_simple => $delete_all, |
|
| 86 |
+ select => $select, |
|
| 87 |
+ select_simple => $select |
|
| 88 |
+ ); |
|
| 89 |
+ |
|
| 90 |
+ return $self; |
|
| 91 |
+} |
|
| 92 |
+ |
|
| 93 |
+our $AUTOLOAD; |
|
| 94 |
+ |
|
| 95 |
+sub AUTOLOAD {
|
|
| 96 |
+ my $self = shift; |
|
| 97 |
+ |
|
| 98 |
+ # Method |
|
| 99 |
+ my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/; |
|
| 100 |
+ |
|
| 101 |
+ # Helper |
|
| 102 |
+ $self->{_helpers} ||= {};
|
|
| 103 |
+ croak qq/Can't locate object method "$method" via "$package"/ |
|
| 104 |
+ unless my $helper = $self->{_helpers}->{$method};
|
|
| 105 |
+ |
|
| 106 |
+ # Run |
|
| 107 |
+ return $self->$helper(@_); |
|
| 108 |
+} |
|
| 109 |
+ |
|
| 110 |
+sub helper {
|
|
| 111 |
+ my $self = shift; |
|
| 112 |
+ |
|
| 113 |
+ # Merge |
|
| 114 |
+ my $helpers = ref $_[0] eq 'HASH' ? $_[0] : {@_};
|
|
| 115 |
+ $self->{_helpers} = {%{$self->{_helpers} || {}}, %$helpers};
|
|
| 116 |
+ |
|
| 117 |
+ return $self; |
|
| 118 |
+} |
|
| 119 |
+ |
|
| 120 |
+sub DESTROY { }
|
|
| 121 |
+ |
|
| 122 |
+1; |
|
| 123 |
+ |
|
| 124 |
+=head1 NAME |
|
| 125 |
+ |
|
| 126 |
+DBIx::Custom::Model - Modele base class(experimental) |
|
| 127 |
+ |
|
| 128 |
+=head1 SYNOPSIS |
|
| 129 |
+ |
|
| 130 |
+use DBIx::Custom::Table; |
|
| 131 |
+ |
|
| 132 |
+my $table = DBIx::Custom::Table->new(name => 'books'); |
|
| 133 |
+ |
|
| 134 |
+=head1 METHODS |
|
| 135 |
+ |
|
| 136 |
+L<DBIx::Custom> inherits all methods from L<Object::Simple> |
|
| 137 |
+and implements the following new ones. |
|
| 138 |
+ |
|
| 139 |
+=head2 C<helper> |
|
| 140 |
+ |
|
| 141 |
+ $table->helper(insert => sub {
|
|
| 142 |
+ # ... |
|
| 143 |
+ }); |
|
| 144 |
+ |
|
| 145 |
+=head2 C<new> |
|
| 146 |
+ |
|
| 147 |
+ my $table = DBIx::Custom->new; |
|
| 148 |
+ |
|
| 149 |
+=head2 C<insert> |
|
| 150 |
+ |
|
| 151 |
+ $table->insert(\%param); |
|
| 152 |
+ |
|
| 153 |
+Insert. |
|
| 154 |
+ |
|
| 155 |
+=head2 C<insert_simple> |
|
| 156 |
+ |
|
| 157 |
+Same as C<insert()>. |
|
| 158 |
+ |
|
| 159 |
+=head2 C<update> |
|
| 160 |
+ |
|
| 161 |
+ $table->update(\%param, \%where); |
|
| 162 |
+ |
|
| 163 |
+Update. |
|
| 164 |
+ |
|
| 165 |
+=head2 C<update_simple> |
|
| 166 |
+ |
|
| 167 |
+Same as C<update()>. |
|
| 168 |
+ |
|
| 169 |
+=head2 C<update_all> |
|
| 170 |
+ |
|
| 171 |
+ $table->update_all(\%param); |
|
| 172 |
+ |
|
| 173 |
+Update all. |
|
| 174 |
+ |
|
| 175 |
+=head2 C<update_all_simple> |
|
| 176 |
+ |
|
| 177 |
+Same as C<update_all>. |
|
| 178 |
+ |
|
| 179 |
+=head2 C<delete> |
|
| 180 |
+ |
|
| 181 |
+ $table->delete(\%where); |
|
| 182 |
+ |
|
| 183 |
+=head2 C<delete_simple()> |
|
| 184 |
+ |
|
| 185 |
+Same as C<delete_all()>. |
|
| 186 |
+ |
|
| 187 |
+=head2 C<delete_all> |
|
| 188 |
+ |
|
| 189 |
+ $table->delete_all(\%where); |
|
| 190 |
+ |
|
| 191 |
+=head2 C<delete_all_simple()> |
|
| 192 |
+ |
|
| 193 |
+Same as C<delete_all()>. |
|
| 194 |
+ |
|
| 195 |
+=head2 C<select> |
|
| 196 |
+ |
|
| 197 |
+ $table->select(\%where); |
|
| 198 |
+ $table->select(\@column); |
|
| 199 |
+ $table->select($append); |
|
| 200 |
+ |
|
| 201 |
+ # And any combination |
|
| 202 |
+ $table->select(\%where, \@column, $append); |
|
| 203 |
+ |
|
| 204 |
+=head2 C<select_simple> |
|
| 205 |
+ |
|
| 206 |
+Same as C<select()>. |
|
| 207 |
+ |
| ... | ... |
@@ -62,6 +62,8 @@ my $insert_query; |
| 62 | 62 |
my $update_query; |
| 63 | 63 |
my $ret_val; |
| 64 | 64 |
my $infos; |
| 65 |
+my $model; |
|
| 66 |
+my $table; |
|
| 65 | 67 |
|
| 66 | 68 |
# Prepare table |
| 67 | 69 |
$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
|
| ... | ... |
@@ -747,3 +749,36 @@ is_deeply($infos, |
| 747 | 749 |
, $test |
| 748 | 750 |
); |
| 749 | 751 |
|
| 752 |
+test 'model'; |
|
| 753 |
+{
|
|
| 754 |
+ package MyModel1; |
|
| 755 |
+ |
|
| 756 |
+ use base 'DBIx::Custom::Model'; |
|
| 757 |
+} |
|
| 758 |
+$model = MyModel1->new; |
|
| 759 |
+$model->dbi->connect($NEW_ARGS->{0});
|
|
| 760 |
+$model->dbi->execute($CREATE_TABLE->{0});
|
|
| 761 |
+$table = $model->table('table1');
|
|
| 762 |
+$table->insert({key1 => 1, key2 => 2});
|
|
| 763 |
+$table->insert_simple({key1 => 3, key2 => 4});
|
|
| 764 |
+$rows = $table->select->fetch_hash_all; |
|
| 765 |
+is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}],
|
|
| 766 |
+ "$test: select"); |
|
| 767 |
+$rows = $table->select({key2 => 2},
|
|
| 768 |
+ 'order by key1', ['key1', 'key2'])->fetch_hash_all; |
|
| 769 |
+is_deeply($rows, [{key1 => 1, key2 => 2}],
|
|
| 770 |
+ "$test: insert insert_simple select select_simple"); |
|
| 771 |
+$table->update({key1 => 3}, {key2 => 2});
|
|
| 772 |
+$table->update_simple({key1 => 5}, {key2 => 4});
|
|
| 773 |
+$rows = $table->select_simple({key2 => 2})->fetch_hash_all;
|
|
| 774 |
+is_deeply($rows, [{key1 => 3, key2 => 2}],
|
|
| 775 |
+ "$test: update"); |
|
| 776 |
+$table->delete({key2 => 2});
|
|
| 777 |
+$rows = $table->select->fetch_hash_all; |
|
| 778 |
+is_deeply($rows, [{key1 => 5, key2 => 4}], "$test: delete");
|
|
| 779 |
+$table->delete_all; |
|
| 780 |
+$rows = $table->select->fetch_hash_all; |
|
| 781 |
+is_deeply($rows, [], "$test: delete_all"); |
|
| 782 |
+$table->helper('insert' => sub { 5 });
|
|
| 783 |
+is($table->insert, 5, "$test : helper"); |
|
| 784 |
+ |