| ... | ... | 
                  @@ -1,3 +1,6 @@  | 
              
| 1 | 
                  +0.1618  | 
              |
| 2 | 
                  + added helper method  | 
              |
| 3 | 
                  + added begin_work, commit, and rollback method  | 
              |
| 1 | 4 | 
                  0.1617  | 
              
| 2 | 5 | 
                  L<DBIx::Custom> is now stable. APIs keep backword compatible in the feature.  | 
              
| 3 | 6 | 
                  0.1616  | 
              
| ... | ... | 
                  @@ -1,6 +1,6 @@  | 
              
| 1 | 1 | 
                  package DBIx::Custom;  | 
              
| 2 | 2 | 
                   | 
              
| 3 | 
                  -our $VERSION = '0.1617';  | 
              |
| 3 | 
                  +our $VERSION = '0.1618';  | 
              |
| 4 | 4 | 
                   | 
              
| 5 | 5 | 
                  use 5.008001;  | 
              
| 6 | 6 | 
                  use strict;  | 
              
| ... | ... | 
                  @@ -15,19 +15,8 @@ use DBIx::Custom::Query;  | 
              
| 15 | 15 | 
                  use DBIx::Custom::QueryBuilder;  | 
              
| 16 | 16 | 
                  use Encode qw/encode_utf8 decode_utf8/;  | 
              
| 17 | 17 | 
                   | 
              
| 18 | 
                  -__PACKAGE__->attr('dbh');
                 | 
              |
| 19 | 
                  -__PACKAGE__->attr([qw/user password data_source/]);  | 
              |
| 20 | 
                  -__PACKAGE__->attr([qw/default_bind_filter default_fetch_filter/]);  | 
              |
| 21 | 
                  -  | 
              |
| 22 | 
                  -__PACKAGE__->dual_attr('filters', default => sub { {} },
                 | 
              |
| 23 | 
                  - inherit => 'hash_copy');  | 
              |
| 24 | 
                  -__PACKAGE__->register_filter(  | 
              |
| 25 | 
                  -    encode_utf8 => sub { encode_utf8($_[0]) },
                 | 
              |
| 26 | 
                  -    decode_utf8 => sub { decode_utf8($_[0]) }
                 | 
              |
| 27 | 
                  -);  | 
              |
| 28 | 
                  -  | 
              |
| 29 | 
                  -__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');  | 
              |
| 30 | 
                  -__PACKAGE__->attr(query_builder  => sub {DBIx::Custom::QueryBuilder->new});
                 | 
              |
| 18 | 
                  +__PACKAGE__->attr([qw/data_source dbh default_bind_filter  | 
              |
| 19 | 
                  + default_fetch_filter password user/]);  | 
              |
| 31 | 20 | 
                   | 
              
| 32 | 21 | 
                  __PACKAGE__->attr(cache => 1);  | 
              
| 33 | 22 | 
                   __PACKAGE__->attr(cache_method => sub {
                 | 
              
| ... | ... | 
                  @@ -45,7 +34,30 @@ __PACKAGE__->attr(cache_method => sub {
                 | 
              
| 45 | 34 | 
                  }  | 
              
| 46 | 35 | 
                  });  | 
              
| 47 | 36 | 
                   | 
              
| 37 | 
                  +__PACKAGE__->dual_attr('filters', default => sub { {} },
                 | 
              |
| 38 | 
                  + inherit => 'hash_copy');  | 
              |
| 48 | 39 | 
                  __PACKAGE__->attr(filter_check => 1);  | 
              
| 40 | 
                  +__PACKAGE__->attr(query_builder  => sub {DBIx::Custom::QueryBuilder->new});
                 | 
              |
| 41 | 
                  +__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');  | 
              |
| 42 | 
                  +  | 
              |
| 43 | 
                  +# DBI methods  | 
              |
| 44 | 
                  +foreach my $method (qw/begin_work commit rollback/) {
                 | 
              |
| 45 | 
                  +    my $code = sub {
                 | 
              |
| 46 | 
                  + my $self = shift;  | 
              |
| 47 | 
                  +        my $ret = eval {$self->dbh->$method};
                 | 
              |
| 48 | 
                  + croak $@ if $@;  | 
              |
| 49 | 
                  + return $ret;  | 
              |
| 50 | 
                  + };  | 
              |
| 51 | 
                  + no strict 'refs';  | 
              |
| 52 | 
                  + my $pkg = __PACKAGE__;  | 
              |
| 53 | 
                  +    *{"${pkg}::$method"} = $code;
                 | 
              |
| 54 | 
                  +};  | 
              |
| 55 | 
                  +  | 
              |
| 56 | 
                  +# Regster filter  | 
              |
| 57 | 
                  +__PACKAGE__->register_filter(  | 
              |
| 58 | 
                  +    encode_utf8 => sub { encode_utf8($_[0]) },
                 | 
              |
| 59 | 
                  +    decode_utf8 => sub { decode_utf8($_[0]) }
                 | 
              |
| 60 | 
                  +);  | 
              |
| 49 | 61 | 
                   | 
              
| 50 | 62 | 
                   sub connect {
                 | 
              
| 51 | 63 | 
                  my $proto = shift;  | 
              
| ... | ... | 
                  @@ -80,70 +92,67 @@ sub connect {
                 | 
              
| 80 | 92 | 
                  return $self;  | 
              
| 81 | 93 | 
                  }  | 
              
| 82 | 94 | 
                   | 
              
| 83 | 
                  -sub register_filter {
                 | 
              |
| 84 | 
                  - my $invocant = shift;  | 
              |
| 95 | 
                  +sub create_query {
                 | 
              |
| 96 | 
                  + my ($self, $source) = @_;  | 
              |
| 85 | 97 | 
                   | 
              
| 86 | 
                  - # Register filter  | 
              |
| 87 | 
                  -    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
                 | 
              |
| 88 | 
                  -    $invocant->filters({%{$invocant->filters}, %$filters});
                 | 
              |
| 98 | 
                  + # Cache  | 
              |
| 99 | 
                  + my $cache = $self->cache;  | 
              |
| 89 | 100 | 
                   | 
              
| 90 | 
                  - return $invocant;  | 
              |
| 91 | 
                  -}  | 
              |
| 92 | 
                  -  | 
              |
| 93 | 
                  -our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
                 | 
              |
| 101 | 
                  + # Create query  | 
              |
| 102 | 
                  + my $query;  | 
              |
| 103 | 
                  +    if ($cache) {
                 | 
              |
| 104 | 
                  +  | 
              |
| 105 | 
                  + # Get query  | 
              |
| 106 | 
                  + my $q = $self->cache_method->($self, $source);  | 
              |
| 107 | 
                  +  | 
              |
| 108 | 
                  + # Create query  | 
              |
| 109 | 
                  + $query = DBIx::Custom::Query->new($q) if $q;  | 
              |
| 110 | 
                  + }  | 
              |
| 111 | 
                  +  | 
              |
| 112 | 
                  +    unless ($query) {
                 | 
              |
| 94 | 113 | 
                   | 
              
| 95 | 
                  -sub insert {
                 | 
              |
| 96 | 
                  - my ($self, %args) = @_;  | 
              |
| 114 | 
                  + # Create SQL object  | 
              |
| 115 | 
                  + my $builder = $self->query_builder;  | 
              |
| 116 | 
                  +  | 
              |
| 117 | 
                  + # Create query  | 
              |
| 118 | 
                  + $query = $builder->build_query($source);  | 
              |
| 97 | 119 | 
                   | 
              
| 98 | 
                  - # Check arguments  | 
              |
| 99 | 
                  -    foreach my $name (keys %args) {
                 | 
              |
| 100 | 
                  -        croak qq{"$name" is invalid argument}
                 | 
              |
| 101 | 
                  -          unless $VALID_INSERT_ARGS{$name};
                 | 
              |
| 120 | 
                  + # Cache query  | 
              |
| 121 | 
                  + $self->cache_method->($self, $source,  | 
              |
| 122 | 
                  +                             {sql     => $query->sql, 
                 | 
              |
| 123 | 
                  + columns => $query->columns})  | 
              |
| 124 | 
                  + if $cache;  | 
              |
| 102 | 125 | 
                  }  | 
              
| 103 | 126 | 
                   | 
              
| 104 | 
                  - # Arguments  | 
              |
| 105 | 
                  -    my $table  = $args{table} || '';
                 | 
              |
| 106 | 
                  -    my $param  = $args{param} || {};
                 | 
              |
| 107 | 
                  -    my $append = $args{append} || '';
                 | 
              |
| 108 | 
                  -    my $filter = $args{filter};
                 | 
              |
| 109 | 
                  -  | 
              |
| 110 | 
                  - # Insert keys  | 
              |
| 111 | 
                  - my @insert_keys = keys %$param;  | 
              |
| 112 | 
                  -  | 
              |
| 113 | 
                  - # Templte for insert  | 
              |
| 114 | 
                  -    my $source = "insert into $table {insert_param "
                 | 
              |
| 115 | 
                  -               . join(' ', @insert_keys) . '}';
                 | 
              |
| 116 | 
                  - $source .= " $append" if $append;  | 
              |
| 127 | 
                  + # Prepare statement handle  | 
              |
| 128 | 
                  + my $sth;  | 
              |
| 129 | 
                  +    eval { $sth = $self->dbh->prepare($query->{sql})};
                 | 
              |
| 130 | 
                  +    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
                 | 
              |
| 117 | 131 | 
                   | 
              
| 118 | 
                  - # Execute query  | 
              |
| 119 | 
                  - my $ret_val = $self->execute($source, param => $param,  | 
              |
| 120 | 
                  - filter => $filter);  | 
              |
| 132 | 
                  + # Set statement handle  | 
              |
| 133 | 
                  + $query->sth($sth);  | 
              |
| 121 | 134 | 
                   | 
              
| 122 | 
                  - return $ret_val;  | 
              |
| 135 | 
                  + return $query;  | 
              |
| 123 | 136 | 
                  }  | 
              
| 124 | 137 | 
                   | 
              
| 125 | 
                  -our %VALID_UPDATE_ARGS  | 
              |
| 126 | 
                  -  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
                 | 
              |
| 138 | 
                  +our %VALID_DELETE_ARGS  | 
              |
| 139 | 
                  +  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
                 | 
              |
| 127 | 140 | 
                   | 
              
| 128 | 
                  -sub update {
                 | 
              |
| 141 | 
                  +sub delete {
                 | 
              |
| 129 | 142 | 
                  my ($self, %args) = @_;  | 
              
| 130 | 143 | 
                   | 
              
| 131 | 144 | 
                  # Check arguments  | 
              
| 132 | 145 | 
                       foreach my $name (keys %args) {
                 | 
              
| 133 | 146 | 
                           croak qq{"$name" is invalid argument}
                 | 
              
| 134 | 
                  -          unless $VALID_UPDATE_ARGS{$name};
                 | 
              |
| 147 | 
                  +          unless $VALID_DELETE_ARGS{$name};
                 | 
              |
| 135 | 148 | 
                  }  | 
              
| 136 | 149 | 
                   | 
              
| 137 | 150 | 
                  # Arguments  | 
              
| 138 | 151 | 
                       my $table            = $args{table} || '';
                 | 
              
| 139 | 
                  -    my $param            = $args{param} || {};
                 | 
              |
| 140 | 152 | 
                       my $where            = $args{where} || {};
                 | 
              
| 141 | 
                  -    my $append = $args{append} || '';
                 | 
              |
| 153 | 
                  +    my $append = $args{append};
                 | 
              |
| 142 | 154 | 
                       my $filter           = $args{filter};
                 | 
              
| 143 | 
                  -    my $allow_update_all = $args{allow_update_all};
                 | 
              |
| 144 | 
                  -  | 
              |
| 145 | 
                  - # Update keys  | 
              |
| 146 | 
                  - my @update_keys = keys %$param;  | 
              |
| 155 | 
                  +    my $allow_delete_all = $args{allow_delete_all};
                 | 
              |
| 147 | 156 | 
                   | 
              
| 148 | 157 | 
                  # Where keys  | 
              
| 149 | 158 | 
                  my @where_keys = keys %$where;  | 
              
| ... | ... | 
                  @@ -151,15 +160,10 @@ sub update {
                 | 
              
| 151 | 160 | 
                  # Not exists where keys  | 
              
| 152 | 161 | 
                       croak qq{"where" argument must be specified and } .
                 | 
              
| 153 | 162 | 
                             qq{contains the pairs of column name and value}
                 | 
              
| 154 | 
                  - if !@where_keys && !$allow_update_all;  | 
              |
| 155 | 
                  -  | 
              |
| 156 | 
                  - # Update clause  | 
              |
| 157 | 
                  -    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
                 | 
              |
| 163 | 
                  + if !@where_keys && !$allow_delete_all;  | 
              |
| 158 | 164 | 
                   | 
              
| 159 | 165 | 
                  # Where clause  | 
              
| 160 | 166 | 
                  my $where_clause = '';  | 
              
| 161 | 
                  -    my $new_where = {};
                 | 
              |
| 162 | 
                  -  | 
              |
| 163 | 167 | 
                       if (@where_keys) {
                 | 
              
| 164 | 168 | 
                  $where_clause = 'where ';  | 
              
| 165 | 169 | 
                           $where_clause .= "{= $_} and " for @where_keys;
                 | 
              
| ... | ... | 
                  @@ -167,79 +171,103 @@ sub update {
                 | 
              
| 167 | 171 | 
                  }  | 
              
| 168 | 172 | 
                   | 
              
| 169 | 173 | 
                  # Source of SQL  | 
              
| 170 | 
                  - my $source = "update $table $update_clause $where_clause";  | 
              |
| 174 | 
                  + my $source = "delete from $table $where_clause";  | 
              |
| 171 | 175 | 
                  $source .= " $append" if $append;  | 
              
| 172 | 176 | 
                   | 
              
| 173 | 
                  - # Rearrange parameters  | 
              |
| 174 | 
                  -    foreach my $wkey (@where_keys) {
                 | 
              |
| 175 | 
                  -  | 
              |
| 176 | 
                  -        if (exists $param->{$wkey}) {
                 | 
              |
| 177 | 
                  -            $param->{$wkey} = [$param->{$wkey}]
                 | 
              |
| 178 | 
                  -              unless ref $param->{$wkey} eq 'ARRAY';
                 | 
              |
| 179 | 
                  -  | 
              |
| 180 | 
                  -            push @{$param->{$wkey}}, $where->{$wkey};
                 | 
              |
| 181 | 
                  - }  | 
              |
| 182 | 
                  -        else {
                 | 
              |
| 183 | 
                  -            $param->{$wkey} = $where->{$wkey};
                 | 
              |
| 184 | 
                  - }  | 
              |
| 185 | 
                  - }  | 
              |
| 186 | 
                  -  | 
              |
| 187 | 177 | 
                  # Execute query  | 
              
| 188 | 
                  - my $ret_val = $self->execute($source, param => $param,  | 
              |
| 178 | 
                  + my $ret_val = $self->execute($source, param => $where,  | 
              |
| 189 | 179 | 
                  filter => $filter);  | 
              
| 190 | 180 | 
                   | 
              
| 191 | 181 | 
                  return $ret_val;  | 
              
| 192 | 182 | 
                  }  | 
              
| 193 | 183 | 
                   | 
              
| 194 | 
                  -sub update_all { shift->update(allow_update_all => 1, @_) };
                 | 
              |
| 184 | 
                  +sub delete_all { shift->delete(allow_delete_all => 1, @_) }
                 | 
              |
| 195 | 185 | 
                   | 
              
| 196 | 
                  -our %VALID_DELETE_ARGS  | 
              |
| 197 | 
                  -  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
                 | 
              |
| 186 | 
                  +our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
                 | 
              |
| 198 | 187 | 
                   | 
              
| 199 | 
                  -sub delete {
                 | 
              |
| 200 | 
                  - my ($self, %args) = @_;  | 
              |
| 188 | 
                  +sub execute{
                 | 
              |
| 189 | 
                  + my ($self, $query, %args) = @_;  | 
              |
| 201 | 190 | 
                   | 
              
| 202 | 191 | 
                  # Check arguments  | 
              
| 203 | 192 | 
                       foreach my $name (keys %args) {
                 | 
              
| 204 | 193 | 
                           croak qq{"$name" is invalid argument}
                 | 
              
| 205 | 
                  -          unless $VALID_DELETE_ARGS{$name};
                 | 
              |
| 194 | 
                  +          unless $VALID_EXECUTE_ARGS{$name};
                 | 
              |
| 206 | 195 | 
                  }  | 
              
| 207 | 196 | 
                   | 
              
| 208 | 
                  - # Arguments  | 
              |
| 209 | 
                  -    my $table            = $args{table} || '';
                 | 
              |
| 210 | 
                  -    my $where            = $args{where} || {};
                 | 
              |
| 211 | 
                  -    my $append = $args{append};
                 | 
              |
| 212 | 
                  -    my $filter           = $args{filter};
                 | 
              |
| 213 | 
                  -    my $allow_delete_all = $args{allow_delete_all};
                 | 
              |
| 197 | 
                  +    my $params = $args{param} || {};
                 | 
              |
| 214 | 198 | 
                   | 
              
| 215 | 
                  - # Where keys  | 
              |
| 216 | 
                  - my @where_keys = keys %$where;  | 
              |
| 199 | 
                  + # First argument is the soruce of SQL  | 
              |
| 200 | 
                  + $query = $self->create_query($query)  | 
              |
| 201 | 
                  + unless ref $query;  | 
              |
| 217 | 202 | 
                   | 
              
| 218 | 
                  - # Not exists where keys  | 
              |
| 219 | 
                  -    croak qq{"where" argument must be specified and } .
                 | 
              |
| 220 | 
                  -          qq{contains the pairs of column name and value}
                 | 
              |
| 221 | 
                  - if !@where_keys && !$allow_delete_all;  | 
              |
| 203 | 
                  +    my $filter = $args{filter} || $query->filter || {};
                 | 
              |
| 222 | 204 | 
                   | 
              
| 223 | 
                  - # Where clause  | 
              |
| 224 | 
                  - my $where_clause = '';  | 
              |
| 225 | 
                  -    if (@where_keys) {
                 | 
              |
| 226 | 
                  - $where_clause = 'where ';  | 
              |
| 227 | 
                  -        $where_clause .= "{= $_} and " for @where_keys;
                 | 
              |
| 228 | 
                  - $where_clause =~ s/ and $//;  | 
              |
| 205 | 
                  + # Create bind value  | 
              |
| 206 | 
                  + my $bind_values = $self->_build_bind_values($query, $params, $filter);  | 
              |
| 207 | 
                  +  | 
              |
| 208 | 
                  + # Execute  | 
              |
| 209 | 
                  + my $sth = $query->sth;  | 
              |
| 210 | 
                  + my $affected;  | 
              |
| 211 | 
                  +    eval {$affected = $sth->execute(@$bind_values)};
                 | 
              |
| 212 | 
                  + $self->_croak($@) if $@;  | 
              |
| 213 | 
                  +  | 
              |
| 214 | 
                  + # Return resultset if select statement is executed  | 
              |
| 215 | 
                  +    if ($sth->{NUM_OF_FIELDS}) {
                 | 
              |
| 216 | 
                  +  | 
              |
| 217 | 
                  + # Create result  | 
              |
| 218 | 
                  + my $result = $self->result_class->new(  | 
              |
| 219 | 
                  + sth => $sth,  | 
              |
| 220 | 
                  + default_filter => $self->default_fetch_filter,  | 
              |
| 221 | 
                  + filters => $self->filters,  | 
              |
| 222 | 
                  + filter_check => $self->filter_check  | 
              |
| 223 | 
                  + );  | 
              |
| 224 | 
                  +  | 
              |
| 225 | 
                  + return $result;  | 
              |
| 226 | 
                  + }  | 
              |
| 227 | 
                  + return $affected;  | 
              |
| 228 | 
                  +}  | 
              |
| 229 | 
                  +  | 
              |
| 230 | 
                  +our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
                 | 
              |
| 231 | 
                  +  | 
              |
| 232 | 
                  +sub insert {
                 | 
              |
| 233 | 
                  + my ($self, %args) = @_;  | 
              |
| 234 | 
                  +  | 
              |
| 235 | 
                  + # Check arguments  | 
              |
| 236 | 
                  +    foreach my $name (keys %args) {
                 | 
              |
| 237 | 
                  +        croak qq{"$name" is invalid argument}
                 | 
              |
| 238 | 
                  +          unless $VALID_INSERT_ARGS{$name};
                 | 
              |
| 229 | 239 | 
                  }  | 
              
| 230 | 240 | 
                   | 
              
| 231 | 
                  - # Source of SQL  | 
              |
| 232 | 
                  - my $source = "delete from $table $where_clause";  | 
              |
| 241 | 
                  + # Arguments  | 
              |
| 242 | 
                  +    my $table  = $args{table} || '';
                 | 
              |
| 243 | 
                  +    my $param  = $args{param} || {};
                 | 
              |
| 244 | 
                  +    my $append = $args{append} || '';
                 | 
              |
| 245 | 
                  +    my $filter = $args{filter};
                 | 
              |
| 246 | 
                  +  | 
              |
| 247 | 
                  + # Insert keys  | 
              |
| 248 | 
                  + my @insert_keys = keys %$param;  | 
              |
| 249 | 
                  +  | 
              |
| 250 | 
                  + # Templte for insert  | 
              |
| 251 | 
                  +    my $source = "insert into $table {insert_param "
                 | 
              |
| 252 | 
                  +               . join(' ', @insert_keys) . '}';
                 | 
              |
| 233 | 253 | 
                  $source .= " $append" if $append;  | 
              
| 234 | 254 | 
                   | 
              
| 235 | 255 | 
                  # Execute query  | 
              
| 236 | 
                  - my $ret_val = $self->execute($source, param => $where,  | 
              |
| 237 | 
                  - filter => $filter);  | 
              |
| 256 | 
                  + my $ret_val = $self->execute($source, param => $param,  | 
              |
| 257 | 
                  + filter => $filter);  | 
              |
| 238 | 258 | 
                   | 
              
| 239 | 259 | 
                  return $ret_val;  | 
              
| 240 | 260 | 
                  }  | 
              
| 241 | 261 | 
                   | 
              
| 242 | 
                  -sub delete_all { shift->delete(allow_delete_all => 1, @_) }
                 | 
              |
| 262 | 
                  +sub register_filter {
                 | 
              |
| 263 | 
                  + my $invocant = shift;  | 
              |
| 264 | 
                  +  | 
              |
| 265 | 
                  + # Register filter  | 
              |
| 266 | 
                  +    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
                 | 
              |
| 267 | 
                  +    $invocant->filters({%{$invocant->filters}, %$filters});
                 | 
              |
| 268 | 
                  +  | 
              |
| 269 | 
                  + return $invocant;  | 
              |
| 270 | 
                  +}  | 
              |
| 243 | 271 | 
                   | 
              
| 244 | 272 | 
                  our %VALID_SELECT_ARGS  | 
              
| 245 | 273 | 
                     = map { $_ => 1 } qw/table column where append relation filter param/;
                 | 
              
| ... | ... | 
                  @@ -320,112 +348,77 @@ sub select {
                 | 
              
| 320 | 348 | 
                  return $result;  | 
              
| 321 | 349 | 
                  }  | 
              
| 322 | 350 | 
                   | 
              
| 323 | 
                  -sub create_query {
                 | 
              |
| 324 | 
                  - my ($self, $source) = @_;  | 
              |
| 325 | 
                  -  | 
              |
| 326 | 
                  - # Cache  | 
              |
| 327 | 
                  - my $cache = $self->cache;  | 
              |
| 351 | 
                  +our %VALID_UPDATE_ARGS  | 
              |
| 352 | 
                  +  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
                 | 
              |
| 353 | 
                  +  | 
              |
| 354 | 
                  +sub update {
                 | 
              |
| 355 | 
                  + my ($self, %args) = @_;  | 
              |
| 328 | 356 | 
                   | 
              
| 329 | 
                  - # Create query  | 
              |
| 330 | 
                  - my $query;  | 
              |
| 331 | 
                  -    if ($cache) {
                 | 
              |
| 332 | 
                  -  | 
              |
| 333 | 
                  - # Get query  | 
              |
| 334 | 
                  - my $q = $self->cache_method->($self, $source);  | 
              |
| 335 | 
                  -  | 
              |
| 336 | 
                  - # Create query  | 
              |
| 337 | 
                  - $query = DBIx::Custom::Query->new($q) if $q;  | 
              |
| 357 | 
                  + # Check arguments  | 
              |
| 358 | 
                  +    foreach my $name (keys %args) {
                 | 
              |
| 359 | 
                  +        croak qq{"$name" is invalid argument}
                 | 
              |
| 360 | 
                  +          unless $VALID_UPDATE_ARGS{$name};
                 | 
              |
| 338 | 361 | 
                  }  | 
              
| 339 | 362 | 
                   | 
              
| 340 | 
                  -    unless ($query) {
                 | 
              |
| 341 | 
                  -  | 
              |
| 342 | 
                  - # Create SQL object  | 
              |
| 343 | 
                  - my $builder = $self->query_builder;  | 
              |
| 344 | 
                  -  | 
              |
| 345 | 
                  - # Create query  | 
              |
| 346 | 
                  - $query = $builder->build_query($source);  | 
              |
| 347 | 
                  -  | 
              |
| 348 | 
                  - # Cache query  | 
              |
| 349 | 
                  - $self->cache_method->($self, $source,  | 
              |
| 350 | 
                  -                             {sql     => $query->sql, 
                 | 
              |
| 351 | 
                  - columns => $query->columns})  | 
              |
| 352 | 
                  - if $cache;  | 
              |
| 353 | 
                  - }  | 
              |
| 363 | 
                  + # Arguments  | 
              |
| 364 | 
                  +    my $table            = $args{table} || '';
                 | 
              |
| 365 | 
                  +    my $param            = $args{param} || {};
                 | 
              |
| 366 | 
                  +    my $where            = $args{where} || {};
                 | 
              |
| 367 | 
                  +    my $append = $args{append} || '';
                 | 
              |
| 368 | 
                  +    my $filter           = $args{filter};
                 | 
              |
| 369 | 
                  +    my $allow_update_all = $args{allow_update_all};
                 | 
              |
| 354 | 370 | 
                   | 
              
| 355 | 
                  - # Prepare statement handle  | 
              |
| 356 | 
                  - my $sth;  | 
              |
| 357 | 
                  -    eval { $sth = $self->dbh->prepare($query->{sql})};
                 | 
              |
| 358 | 
                  -    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
                 | 
              |
| 371 | 
                  + # Update keys  | 
              |
| 372 | 
                  + my @update_keys = keys %$param;  | 
              |
| 359 | 373 | 
                   | 
              
| 360 | 
                  - # Set statement handle  | 
              |
| 361 | 
                  - $query->sth($sth);  | 
              |
| 374 | 
                  + # Where keys  | 
              |
| 375 | 
                  + my @where_keys = keys %$where;  | 
              |
| 362 | 376 | 
                   | 
              
| 363 | 
                  - return $query;  | 
              |
| 364 | 
                  -}  | 
              |
| 365 | 
                  -  | 
              |
| 366 | 
                  -sub _croak {
                 | 
              |
| 367 | 
                  - my ($self, $error, $append) = @_;  | 
              |
| 368 | 
                  - $append ||= "";  | 
              |
| 377 | 
                  + # Not exists where keys  | 
              |
| 378 | 
                  +    croak qq{"where" argument must be specified and } .
                 | 
              |
| 379 | 
                  +          qq{contains the pairs of column name and value}
                 | 
              |
| 380 | 
                  + if !@where_keys && !$allow_update_all;  | 
              |
| 369 | 381 | 
                   | 
              
| 370 | 
                  - # Verbose  | 
              |
| 371 | 
                  -    if ($Carp::Verbose) { croak $error }
                 | 
              |
| 382 | 
                  + # Update clause  | 
              |
| 383 | 
                  +    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
                 | 
              |
| 372 | 384 | 
                   | 
              
| 373 | 
                  - # Not verbose  | 
              |
| 374 | 
                  -    else {
                 | 
              |
| 375 | 
                  -  | 
              |
| 376 | 
                  - # Remove line and module infromation  | 
              |
| 377 | 
                  - my $at_pos = rindex($error, ' at ');  | 
              |
| 378 | 
                  - $error = substr($error, 0, $at_pos);  | 
              |
| 379 | 
                  - $error =~ s/\s+$//;  | 
              |
| 380 | 
                  -  | 
              |
| 381 | 
                  - croak "$error$append";  | 
              |
| 382 | 
                  - }  | 
              |
| 383 | 
                  -}  | 
              |
| 384 | 
                  -  | 
              |
| 385 | 
                  -our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
                 | 
              |
| 386 | 
                  -  | 
              |
| 387 | 
                  -sub execute{
                 | 
              |
| 388 | 
                  - my ($self, $query, %args) = @_;  | 
              |
| 385 | 
                  + # Where clause  | 
              |
| 386 | 
                  + my $where_clause = '';  | 
              |
| 387 | 
                  +    my $new_where = {};
                 | 
              |
| 389 | 388 | 
                   | 
              
| 390 | 
                  - # Check arguments  | 
              |
| 391 | 
                  -    foreach my $name (keys %args) {
                 | 
              |
| 392 | 
                  -        croak qq{"$name" is invalid argument}
                 | 
              |
| 393 | 
                  -          unless $VALID_EXECUTE_ARGS{$name};
                 | 
              |
| 389 | 
                  +    if (@where_keys) {
                 | 
              |
| 390 | 
                  + $where_clause = 'where ';  | 
              |
| 391 | 
                  +        $where_clause .= "{= $_} and " for @where_keys;
                 | 
              |
| 392 | 
                  + $where_clause =~ s/ and $//;  | 
              |
| 394 | 393 | 
                  }  | 
              
| 395 | 394 | 
                   | 
              
| 396 | 
                  -    my $params = $args{param} || {};
                 | 
              |
| 397 | 
                  -  | 
              |
| 398 | 
                  - # First argument is the soruce of SQL  | 
              |
| 399 | 
                  - $query = $self->create_query($query)  | 
              |
| 400 | 
                  - unless ref $query;  | 
              |
| 401 | 
                  -  | 
              |
| 402 | 
                  -    my $filter = $args{filter} || $query->filter || {};
                 | 
              |
| 403 | 
                  -  | 
              |
| 404 | 
                  - # Create bind value  | 
              |
| 405 | 
                  - my $bind_values = $self->_build_bind_values($query, $params, $filter);  | 
              |
| 406 | 
                  -  | 
              |
| 407 | 
                  - # Execute  | 
              |
| 408 | 
                  - my $sth = $query->sth;  | 
              |
| 409 | 
                  - my $affected;  | 
              |
| 410 | 
                  -    eval {$affected = $sth->execute(@$bind_values)};
                 | 
              |
| 411 | 
                  - $self->_croak($@) if $@;  | 
              |
| 395 | 
                  + # Source of SQL  | 
              |
| 396 | 
                  + my $source = "update $table $update_clause $where_clause";  | 
              |
| 397 | 
                  + $source .= " $append" if $append;  | 
              |
| 412 | 398 | 
                   | 
              
| 413 | 
                  - # Return resultset if select statement is executed  | 
              |
| 414 | 
                  -    if ($sth->{NUM_OF_FIELDS}) {
                 | 
              |
| 399 | 
                  + # Rearrange parameters  | 
              |
| 400 | 
                  +    foreach my $wkey (@where_keys) {
                 | 
              |
| 415 | 401 | 
                   | 
              
| 416 | 
                  - # Create result  | 
              |
| 417 | 
                  - my $result = $self->result_class->new(  | 
              |
| 418 | 
                  - sth => $sth,  | 
              |
| 419 | 
                  - default_filter => $self->default_fetch_filter,  | 
              |
| 420 | 
                  - filters => $self->filters,  | 
              |
| 421 | 
                  - filter_check => $self->filter_check  | 
              |
| 422 | 
                  - );  | 
              |
| 423 | 
                  -  | 
              |
| 424 | 
                  - return $result;  | 
              |
| 402 | 
                  +        if (exists $param->{$wkey}) {
                 | 
              |
| 403 | 
                  +            $param->{$wkey} = [$param->{$wkey}]
                 | 
              |
| 404 | 
                  +              unless ref $param->{$wkey} eq 'ARRAY';
                 | 
              |
| 405 | 
                  +  | 
              |
| 406 | 
                  +            push @{$param->{$wkey}}, $where->{$wkey};
                 | 
              |
| 407 | 
                  + }  | 
              |
| 408 | 
                  +        else {
                 | 
              |
| 409 | 
                  +            $param->{$wkey} = $where->{$wkey};
                 | 
              |
| 410 | 
                  + }  | 
              |
| 425 | 411 | 
                  }  | 
              
| 426 | 
                  - return $affected;  | 
              |
| 412 | 
                  +  | 
              |
| 413 | 
                  + # Execute query  | 
              |
| 414 | 
                  + my $ret_val = $self->execute($source, param => $param,  | 
              |
| 415 | 
                  + filter => $filter);  | 
              |
| 416 | 
                  +  | 
              |
| 417 | 
                  + return $ret_val;  | 
              |
| 427 | 418 | 
                  }  | 
              
| 428 | 419 | 
                   | 
              
| 420 | 
                  +sub update_all { shift->update(allow_update_all => 1, @_) };
                 | 
              |
| 421 | 
                  +  | 
              |
| 429 | 422 | 
                   sub _build_bind_values {
                 | 
              
| 430 | 423 | 
                  my ($self, $query, $params, $filter) = @_;  | 
              
| 431 | 424 | 
                   | 
              
| ... | ... | 
                  @@ -487,6 +480,25 @@ sub _check_filter {
                 | 
              
| 487 | 480 | 
                  }  | 
              
| 488 | 481 | 
                  }  | 
              
| 489 | 482 | 
                   | 
              
| 483 | 
                  +sub _croak {
                 | 
              |
| 484 | 
                  + my ($self, $error, $append) = @_;  | 
              |
| 485 | 
                  + $append ||= "";  | 
              |
| 486 | 
                  +  | 
              |
| 487 | 
                  + # Verbose  | 
              |
| 488 | 
                  +    if ($Carp::Verbose) { croak $error }
                 | 
              |
| 489 | 
                  +  | 
              |
| 490 | 
                  + # Not verbose  | 
              |
| 491 | 
                  +    else {
                 | 
              |
| 492 | 
                  +  | 
              |
| 493 | 
                  + # Remove line and module infromation  | 
              |
| 494 | 
                  + my $at_pos = rindex($error, ' at ');  | 
              |
| 495 | 
                  + $error = substr($error, 0, $at_pos);  | 
              |
| 496 | 
                  + $error =~ s/\s+$//;  | 
              |
| 497 | 
                  +  | 
              |
| 498 | 
                  + croak "$error$append";  | 
              |
| 499 | 
                  + }  | 
              |
| 500 | 
                  +}  | 
              |
| 501 | 
                  +  | 
              |
| 490 | 502 | 
                  1;  | 
              
| 491 | 503 | 
                   | 
              
| 492 | 504 | 
                  =head1 NAME  | 
              
| ... | ... | 
                  @@ -1105,21 +1117,37 @@ You can custamize SQL builder object  | 
              
| 1105 | 1117 | 
                   | 
              
| 1106 | 1118 | 
                  =head1 ATTRIBUTES  | 
              
| 1107 | 1119 | 
                   | 
              
| 1108 | 
                  -=head2 C<user>  | 
              |
| 1120 | 
                  +=head2 C<cache>  | 
              |
| 1109 | 1121 | 
                   | 
              
| 1110 | 
                  - my $user = $dbi->user;  | 
              |
| 1111 | 
                  -    $dbi     = $dbi->user('Ken');
                 | 
              |
| 1122 | 
                  + my $cache = $dbi->cache;  | 
              |
| 1123 | 
                  + $dbi = $dbi->cache(1);  | 
              |
| 1112 | 1124 | 
                   | 
              
| 1113 | 
                  -User name.  | 
              |
| 1114 | 
                  -C<connect()> method use this value to connect the database.  | 
              |
| 1115 | 
                  -  | 
              |
| 1116 | 
                  -=head2 C<password>  | 
              |
| 1125 | 
                  +Enable parsed L<DBIx::Custom::Query> object caching.  | 
              |
| 1126 | 
                  +Default to 1.  | 
              |
| 1117 | 1127 | 
                   | 
              
| 1118 | 
                  - my $password = $dbi->password;  | 
              |
| 1119 | 
                  -    $dbi         = $dbi->password('lkj&le`@s');
                 | 
              |
| 1128 | 
                  +=head2 C<cache_method>  | 
              |
| 1120 | 1129 | 
                   | 
              
| 1121 | 
                  -Password.  | 
              |
| 1122 | 
                  -C<connect()> method use this value to connect the database.  | 
              |
| 1130 | 
                  + $dbi = $dbi->cache_method(\&cache_method);  | 
              |
| 1131 | 
                  + $cache_method = $dbi->cache_method  | 
              |
| 1132 | 
                  +  | 
              |
| 1133 | 
                  +Method to set and get caches.  | 
              |
| 1134 | 
                  +  | 
              |
| 1135 | 
                  +B<Example:>  | 
              |
| 1136 | 
                  +  | 
              |
| 1137 | 
                  + $dbi->cache_method(  | 
              |
| 1138 | 
                  +        sub {
                 | 
              |
| 1139 | 
                  + my $self = shift;  | 
              |
| 1140 | 
                  +  | 
              |
| 1141 | 
                  +            $self->{_cached} ||= {};
                 | 
              |
| 1142 | 
                  +  | 
              |
| 1143 | 
                  +            if (@_ > 1) {
                 | 
              |
| 1144 | 
                  +                $self->{_cached}{$_[0]} = $_[1] 
                 | 
              |
| 1145 | 
                  + }  | 
              |
| 1146 | 
                  +            else {
                 | 
              |
| 1147 | 
                  +                return $self->{_cached}{$_[0]}
                 | 
              |
| 1148 | 
                  + }  | 
              |
| 1149 | 
                  + }  | 
              |
| 1150 | 
                  + );  | 
              |
| 1123 | 1151 | 
                   | 
              
| 1124 | 1152 | 
                  =head2 C<data_source>  | 
              
| 1125 | 1153 | 
                   | 
              
| ... | ... | 
                  @@ -1136,14 +1164,6 @@ C<connect()> method use this value to connect the database.  | 
              
| 1136 | 1164 | 
                   | 
              
| 1137 | 1165 | 
                  L<DBI> object. You can call all methods of L<DBI>.  | 
              
| 1138 | 1166 | 
                   | 
              
| 1139 | 
                  -=head2 C<filters>  | 
              |
| 1140 | 
                  -  | 
              |
| 1141 | 
                  - my $filters = $dbi->filters;  | 
              |
| 1142 | 
                  - $dbi = $dbi->filters(\%filters);  | 
              |
| 1143 | 
                  -  | 
              |
| 1144 | 
                  -Filter functions.  | 
              |
| 1145 | 
                  -"encode_utf8" and "decode_utf8" is registered by default.  | 
              |
| 1146 | 
                  -  | 
              |
| 1147 | 1167 | 
                  =head2 C<default_bind_filter>  | 
              
| 1148 | 1168 | 
                   | 
              
| 1149 | 1169 | 
                  my $default_bind_filter = $dbi->default_bind_filter  | 
              
| ... | ... | 
                  @@ -1158,13 +1178,31 @@ Default filter when parameter binding is executed.  | 
              
| 1158 | 1178 | 
                   | 
              
| 1159 | 1179 | 
                  Default filter when row is fetched.  | 
              
| 1160 | 1180 | 
                   | 
              
| 1161 | 
                  -=head2 C<result_class>  | 
              |
| 1181 | 
                  +=head2 C<filters>  | 
              |
| 1162 | 1182 | 
                   | 
              
| 1163 | 
                  - my $result_class = $dbi->result_class;  | 
              |
| 1164 | 
                  -    $dbi             = $dbi->result_class('DBIx::Custom::Result');
                 | 
              |
| 1183 | 
                  + my $filters = $dbi->filters;  | 
              |
| 1184 | 
                  + $dbi = $dbi->filters(\%filters);  | 
              |
| 1165 | 1185 | 
                   | 
              
| 1166 | 
                  -Result class for select statement.  | 
              |
| 1167 | 
                  -Default to L<DBIx::Custom::Result>.  | 
              |
| 1186 | 
                  +Filter functions.  | 
              |
| 1187 | 
                  +"encode_utf8" and "decode_utf8" is registered by default.  | 
              |
| 1188 | 
                  +  | 
              |
| 1189 | 
                  +=head2 C<filter_check>  | 
              |
| 1190 | 
                  +  | 
              |
| 1191 | 
                  + my $filter_check = $dbi->filter_check;  | 
              |
| 1192 | 
                  + $dbi = $dbi->filter_check(0);  | 
              |
| 1193 | 
                  +  | 
              |
| 1194 | 
                  +Enable filter check.  | 
              |
| 1195 | 
                  +Default to 1.  | 
              |
| 1196 | 
                  +This check maybe damege performance.  | 
              |
| 1197 | 
                  +If you require performance, set C<filter_check> attribute to 0.  | 
              |
| 1198 | 
                  +  | 
              |
| 1199 | 
                  +=head2 C<password>  | 
              |
| 1200 | 
                  +  | 
              |
| 1201 | 
                  + my $password = $dbi->password;  | 
              |
| 1202 | 
                  +    $dbi         = $dbi->password('lkj&le`@s');
                 | 
              |
| 1203 | 
                  +  | 
              |
| 1204 | 
                  +Password.  | 
              |
| 1205 | 
                  +C<connect()> method use this value to connect the database.  | 
              |
| 1168 | 1206 | 
                   | 
              
| 1169 | 1207 | 
                  =head2 C<query_builder>  | 
              
| 1170 | 1208 | 
                   | 
              
| ... | ... | 
                  @@ -1175,53 +1213,44 @@ SQL builder. C<query_builder()> must be  | 
              
| 1175 | 1213 | 
                  the instance of L<DBIx::Custom::QueryBuilder> subclass.  | 
              
| 1176 | 1214 | 
                  Default to L<DBIx::Custom::QueryBuilder> object.  | 
              
| 1177 | 1215 | 
                   | 
              
| 1178 | 
                  -=head2 C<cache>  | 
              |
| 1179 | 
                  -  | 
              |
| 1180 | 
                  - my $cache = $dbi->cache;  | 
              |
| 1181 | 
                  - $dbi = $dbi->cache(1);  | 
              |
| 1182 | 
                  -  | 
              |
| 1183 | 
                  -Enable parsed L<DBIx::Custom::Query> object caching.  | 
              |
| 1184 | 
                  -Default to 1.  | 
              |
| 1216 | 
                  +=head2 C<result_class>  | 
              |
| 1185 | 1217 | 
                   | 
              
| 1186 | 
                  -=head2 C<cache_method>  | 
              |
| 1218 | 
                  + my $result_class = $dbi->result_class;  | 
              |
| 1219 | 
                  +    $dbi             = $dbi->result_class('DBIx::Custom::Result');
                 | 
              |
| 1187 | 1220 | 
                   | 
              
| 1188 | 
                  - $dbi = $dbi->cache_method(\&cache_method);  | 
              |
| 1189 | 
                  - $cache_method = $dbi->cache_method  | 
              |
| 1221 | 
                  +Result class for select statement.  | 
              |
| 1222 | 
                  +Default to L<DBIx::Custom::Result>.  | 
              |
| 1190 | 1223 | 
                   | 
              
| 1191 | 
                  -Method to set and get caches.  | 
              |
| 1224 | 
                  +=head2 C<user>  | 
              |
| 1192 | 1225 | 
                   | 
              
| 1193 | 
                  -B<Example:>  | 
              |
| 1226 | 
                  + my $user = $dbi->user;  | 
              |
| 1227 | 
                  +    $dbi     = $dbi->user('Ken');
                 | 
              |
| 1194 | 1228 | 
                   | 
              
| 1195 | 
                  - $dbi->cache_method(  | 
              |
| 1196 | 
                  -        sub {
                 | 
              |
| 1197 | 
                  - my $self = shift;  | 
              |
| 1198 | 
                  -  | 
              |
| 1199 | 
                  -            $self->{_cached} ||= {};
                 | 
              |
| 1200 | 
                  -  | 
              |
| 1201 | 
                  -            if (@_ > 1) {
                 | 
              |
| 1202 | 
                  -                $self->{_cached}{$_[0]} = $_[1] 
                 | 
              |
| 1203 | 
                  - }  | 
              |
| 1204 | 
                  -            else {
                 | 
              |
| 1205 | 
                  -                return $self->{_cached}{$_[0]}
                 | 
              |
| 1206 | 
                  - }  | 
              |
| 1207 | 
                  - }  | 
              |
| 1208 | 
                  - );  | 
              |
| 1229 | 
                  +User name.  | 
              |
| 1230 | 
                  +C<connect()> method use this value to connect the database.  | 
              |
| 1231 | 
                  +  | 
              |
| 1232 | 
                  +=head1 METHODS  | 
              |
| 1209 | 1233 | 
                   | 
              
| 1210 | 
                  -=head2 C<filter_check>  | 
              |
| 1234 | 
                  +L<DBIx::Custom> inherits all methods from L<Object::Simple>  | 
              |
| 1235 | 
                  +and implements the following new ones.  | 
              |
| 1211 | 1236 | 
                   | 
              
| 1212 | 
                  - my $filter_check = $dbi->filter_check;  | 
              |
| 1213 | 
                  - $dbi = $dbi->filter_check(0);  | 
              |
| 1237 | 
                  +=head2 begin_work  | 
              |
| 1214 | 1238 | 
                   | 
              
| 1215 | 
                  -Enable filter check.  | 
              |
| 1216 | 
                  -Default to 1.  | 
              |
| 1217 | 
                  -This check maybe damege performance.  | 
              |
| 1218 | 
                  -If you require performance, set C<filter_check> attribute to 0.  | 
              |
| 1239 | 
                  + $dbi->begin_work;  | 
              |
| 1219 | 1240 | 
                   | 
              
| 1220 | 
                  -=head1 METHODS  | 
              |
| 1241 | 
                  +Start transaction.  | 
              |
| 1242 | 
                  +This is same as L<DBI>'s C<begin_work>.  | 
              |
| 1221 | 1243 | 
                   | 
              
| 1222 | 1244 | 
                  L<DBIx::Custom> inherits all methods from L<Object::Simple>  | 
              
| 1223 | 1245 | 
                  and implements the following new ones.  | 
              
| 1224 | 1246 | 
                   | 
              
| 1247 | 
                  +=head2 commit  | 
              |
| 1248 | 
                  +  | 
              |
| 1249 | 
                  + $dbi->commit;  | 
              |
| 1250 | 
                  +  | 
              |
| 1251 | 
                  +Commit transaction.  | 
              |
| 1252 | 
                  +This is same as L<DBI>'s C<commit>.  | 
              |
| 1253 | 
                  +  | 
              |
| 1225 | 1254 | 
                  =head2 C<connect>  | 
              
| 1226 | 1255 | 
                   | 
              
| 1227 | 1256 | 
                  my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",  | 
              
| ... | ... | 
                  @@ -1232,74 +1261,40 @@ L<DBIx::Custom> is a wrapper of L<DBI>.  | 
              
| 1232 | 1261 | 
                  C<AutoCommit> and C<RaiseError> options are true,  | 
              
| 1233 | 1262 | 
                  and C<PrintError> option is false by default.  | 
              
| 1234 | 1263 | 
                   | 
              
| 1235 | 
                  -=head2 C<insert>  | 
              |
| 1236 | 
                  -  | 
              |
| 1237 | 
                  - $dbi->insert(table => $table,  | 
              |
| 1238 | 
                  - param => \%param,  | 
              |
| 1239 | 
                  - append => $append,  | 
              |
| 1240 | 
                  - filter => \%filter);  | 
              |
| 1241 | 
                  -  | 
              |
| 1242 | 
                  -Execute insert statement.  | 
              |
| 1243 | 
                  -C<insert> method have C<table>, C<param>, C<append>  | 
              |
| 1244 | 
                  -and C<filter> arguments.  | 
              |
| 1245 | 
                  -C<table> is a table name.  | 
              |
| 1246 | 
                  -C<param> is the pairs of column name value. this must be hash reference.  | 
              |
| 1247 | 
                  -C<append> is a string added at the end of the SQL statement.  | 
              |
| 1248 | 
                  -C<filter> is filters when parameter binding is executed.  | 
              |
| 1249 | 
                  -This is overwrites C<default_bind_filter>.  | 
              |
| 1250 | 
                  -Return value of C<insert()> is the count of affected rows.  | 
              |
| 1251 | 
                  -  | 
              |
| 1252 | 
                  -B<Example:>  | 
              |
| 1253 | 
                  -  | 
              |
| 1254 | 
                  - $dbi->insert(table => 'books',  | 
              |
| 1255 | 
                  -                 param  => {title => 'Perl', author => 'Taro'},
                 | 
              |
| 1256 | 
                  - append => "some statement",  | 
              |
| 1257 | 
                  -                 filter => {title => 'encode_utf8'})
                 | 
              |
| 1258 | 
                  -  | 
              |
| 1259 | 
                  -=head2 C<update>  | 
              |
| 1260 | 
                  -  | 
              |
| 1261 | 
                  - $dbi->update(table => $table,  | 
              |
| 1262 | 
                  - param => \%params,  | 
              |
| 1263 | 
                  - where => \%where,  | 
              |
| 1264 | 
                  - append => $append,  | 
              |
| 1265 | 
                  - filter => \%filter)  | 
              |
| 1266 | 
                  -  | 
              |
| 1267 | 
                  -Execute update statement.  | 
              |
| 1268 | 
                  -C<update> method have C<table>, C<param>, C<where>, C<append>  | 
              |
| 1269 | 
                  -and C<filter> arguments.  | 
              |
| 1270 | 
                  -C<table> is a table name.  | 
              |
| 1271 | 
                  -C<param> is column-value pairs. this must be hash reference.  | 
              |
| 1272 | 
                  -C<where> is where clause. this must be hash reference.  | 
              |
| 1273 | 
                  -C<append> is a string added at the end of the SQL statement.  | 
              |
| 1274 | 
                  -C<filter> is filters when parameter binding is executed.  | 
              |
| 1275 | 
                  -This is overwrites C<default_bind_filter>.  | 
              |
| 1276 | 
                  -Return value of C<update()> is the count of affected rows.  | 
              |
| 1264 | 
                  +=head2 C<create_query>  | 
              |
| 1265 | 
                  +  | 
              |
| 1266 | 
                  + my $query = $dbi->create_query(  | 
              |
| 1267 | 
                  +        "select * from books where {= author} and {like title};"
                 | 
              |
| 1268 | 
                  + );  | 
              |
| 1277 | 1269 | 
                   | 
              
| 1278 | 
                  -B<Example:>  | 
              |
| 1270 | 
                  +Create the instance of L<DBIx::Custom::Query> from the source of SQL.  | 
              |
| 1271 | 
                  +If you want to get high performance,  | 
              |
| 1272 | 
                  +use C<create_query()> method and execute it by C<execute()> method  | 
              |
| 1273 | 
                  +instead of suger methods.  | 
              |
| 1279 | 1274 | 
                   | 
              
| 1280 | 
                  - $dbi->update(table => 'books',  | 
              |
| 1281 | 
                  -                 param  => {title => 'Perl', author => 'Taro'},
                 | 
              |
| 1282 | 
                  -                 where  => {id => 5},
                 | 
              |
| 1283 | 
                  - append => "some statement",  | 
              |
| 1284 | 
                  -                 filter => {title => 'encode_utf8'});
                 | 
              |
| 1275 | 
                  +    $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
                 | 
              |
| 1285 | 1276 | 
                   | 
              
| 1286 | 
                  -=head2 C<update_all>  | 
              |
| 1277 | 
                  +=head2 C<execute>  | 
              |
| 1287 | 1278 | 
                   | 
              
| 1288 | 
                  - $dbi->update_all(table => $table,  | 
              |
| 1289 | 
                  - param => \%params,  | 
              |
| 1290 | 
                  - filter => \%filter,  | 
              |
| 1291 | 
                  - append => $append);  | 
              |
| 1279 | 
                  + my $result = $dbi->execute($query, param => $params, filter => \%filter);  | 
              |
| 1280 | 
                  + my $result = $dbi->execute($source, param => $params, filter => \%filter);  | 
              |
| 1292 | 1281 | 
                   | 
              
| 1293 | 
                  -Execute update statement to update all rows.  | 
              |
| 1294 | 
                  -Arguments is same as C<update> method,  | 
              |
| 1295 | 
                  -except that C<update_all> don't have C<where> argument.  | 
              |
| 1296 | 
                  -Return value of C<update_all()> is the count of affected rows.  | 
              |
| 1282 | 
                  +Execute query or the source of SQL.  | 
              |
| 1283 | 
                  +Query is L<DBIx::Custom::Query> object.  | 
              |
| 1284 | 
                  +Return value is L<DBIx::Custom::Result> if select statement is executed,  | 
              |
| 1285 | 
                  +or the count of affected rows if insert, update, delete statement is executed.  | 
              |
| 1297 | 1286 | 
                   | 
              
| 1298 | 1287 | 
                  B<Example:>  | 
              
| 1299 | 1288 | 
                   | 
              
| 1300 | 
                  - $dbi->update_all(table => 'books',  | 
              |
| 1301 | 
                  -                     param  => {author => 'taro'},
                 | 
              |
| 1302 | 
                  -                     filter => {author => 'encode_utf8'});
                 | 
              |
| 1289 | 
                  + my $result = $dbi->execute(  | 
              |
| 1290 | 
                  +        "select * from books where {= author} and {like title}", 
                 | 
              |
| 1291 | 
                  +        param => {author => 'Ken', title => '%Perl%'}
                 | 
              |
| 1292 | 
                  + );  | 
              |
| 1293 | 
                  +  | 
              |
| 1294 | 
                  +    while (my $row = $result->fetch) {
                 | 
              |
| 1295 | 
                  + my $author = $row->[0];  | 
              |
| 1296 | 
                  + my $title = $row->[1];  | 
              |
| 1297 | 
                  + }  | 
              |
| 1303 | 1298 | 
                   | 
              
| 1304 | 1299 | 
                  =head2 C<delete>  | 
              
| 1305 | 1300 | 
                   | 
              
| ... | ... | 
                  @@ -1336,6 +1331,90 @@ B<Example:>  | 
              
| 1336 | 1331 | 
                   | 
              
| 1337 | 1332 | 
                  $dbi->delete_all(table => 'books');  | 
              
| 1338 | 1333 | 
                   | 
              
| 1334 | 
                  +=head2 C<insert>  | 
              |
| 1335 | 
                  +  | 
              |
| 1336 | 
                  + $dbi->insert(table => $table,  | 
              |
| 1337 | 
                  + param => \%param,  | 
              |
| 1338 | 
                  + append => $append,  | 
              |
| 1339 | 
                  + filter => \%filter);  | 
              |
| 1340 | 
                  +  | 
              |
| 1341 | 
                  +Execute insert statement.  | 
              |
| 1342 | 
                  +C<insert> method have C<table>, C<param>, C<append>  | 
              |
| 1343 | 
                  +and C<filter> arguments.  | 
              |
| 1344 | 
                  +C<table> is a table name.  | 
              |
| 1345 | 
                  +C<param> is the pairs of column name value. this must be hash reference.  | 
              |
| 1346 | 
                  +C<append> is a string added at the end of the SQL statement.  | 
              |
| 1347 | 
                  +C<filter> is filters when parameter binding is executed.  | 
              |
| 1348 | 
                  +This is overwrites C<default_bind_filter>.  | 
              |
| 1349 | 
                  +Return value of C<insert()> is the count of affected rows.  | 
              |
| 1350 | 
                  +  | 
              |
| 1351 | 
                  +B<Example:>  | 
              |
| 1352 | 
                  +  | 
              |
| 1353 | 
                  + $dbi->insert(table => 'books',  | 
              |
| 1354 | 
                  +                 param  => {title => 'Perl', author => 'Taro'},
                 | 
              |
| 1355 | 
                  + append => "some statement",  | 
              |
| 1356 | 
                  +                 filter => {title => 'encode_utf8'})
                 | 
              |
| 1357 | 
                  +  | 
              |
| 1358 | 
                  +=head2 C<register_filter>  | 
              |
| 1359 | 
                  +  | 
              |
| 1360 | 
                  + $dbi->register_filter(%filters);  | 
              |
| 1361 | 
                  + $dbi->register_filter(\%filters);  | 
              |
| 1362 | 
                  +  | 
              |
| 1363 | 
                  +Register filter. Registered filters is available in the following attributes  | 
              |
| 1364 | 
                  +or arguments.  | 
              |
| 1365 | 
                  +  | 
              |
| 1366 | 
                  +=over 4  | 
              |
| 1367 | 
                  +  | 
              |
| 1368 | 
                  +=item *  | 
              |
| 1369 | 
                  +  | 
              |
| 1370 | 
                  +C<default_bind_filter>, C<default_fetch_filter>  | 
              |
| 1371 | 
                  +  | 
              |
| 1372 | 
                  +=item *  | 
              |
| 1373 | 
                  +  | 
              |
| 1374 | 
                  +C<filter> argument of C<insert()>, C<update()>,  | 
              |
| 1375 | 
                  +C<update_all()>, C<delete()>, C<delete_all()>, C<select()>  | 
              |
| 1376 | 
                  +methods  | 
              |
| 1377 | 
                  +  | 
              |
| 1378 | 
                  +=item *  | 
              |
| 1379 | 
                  +  | 
              |
| 1380 | 
                  +C<execute()> method  | 
              |
| 1381 | 
                  +  | 
              |
| 1382 | 
                  +=item *  | 
              |
| 1383 | 
                  +  | 
              |
| 1384 | 
                  +C<default_filter> and C<filter> of C<DBIx::Custom::Query>  | 
              |
| 1385 | 
                  +  | 
              |
| 1386 | 
                  +=item *  | 
              |
| 1387 | 
                  +  | 
              |
| 1388 | 
                  +C<default_filter> and C<filter> of C<DBIx::Custom::Result>  | 
              |
| 1389 | 
                  +  | 
              |
| 1390 | 
                  +=back  | 
              |
| 1391 | 
                  +  | 
              |
| 1392 | 
                  +B<Example:>  | 
              |
| 1393 | 
                  +  | 
              |
| 1394 | 
                  + $dbi->register_filter(  | 
              |
| 1395 | 
                  +        encode_utf8 => sub {
                 | 
              |
| 1396 | 
                  + my $value = shift;  | 
              |
| 1397 | 
                  +  | 
              |
| 1398 | 
                  + require Encode;  | 
              |
| 1399 | 
                  +  | 
              |
| 1400 | 
                  +            return Encode::encode('UTF-8', $value);
                 | 
              |
| 1401 | 
                  + },  | 
              |
| 1402 | 
                  +        decode_utf8 => sub {
                 | 
              |
| 1403 | 
                  + my $value = shift;  | 
              |
| 1404 | 
                  +  | 
              |
| 1405 | 
                  + require Encode;  | 
              |
| 1406 | 
                  +  | 
              |
| 1407 | 
                  +            return Encode::decode('UTF-8', $value)
                 | 
              |
| 1408 | 
                  + }  | 
              |
| 1409 | 
                  + );  | 
              |
| 1410 | 
                  +  | 
              |
| 1411 | 
                  +=head2 rollback  | 
              |
| 1412 | 
                  +  | 
              |
| 1413 | 
                  + $dbi->rollback;  | 
              |
| 1414 | 
                  +  | 
              |
| 1415 | 
                  +Rollback transaction.  | 
              |
| 1416 | 
                  +This is same as L<DBI>'s C<rollback>.  | 
              |
| 1417 | 
                  +  | 
              |
| 1339 | 1418 | 
                  =head2 C<select>  | 
              
| 1340 | 1419 | 
                   | 
              
| 1341 | 1420 | 
                  my $result = $dbi->select(table => $table,  | 
              
| ... | ... | 
                  @@ -1391,93 +1470,50 @@ First element is a string. it contains tags,  | 
              
| 1391 | 1470 | 
                   such as "{= title} or {like author}".
                 | 
              
| 1392 | 1471 | 
                  Second element is paramters.  | 
              
| 1393 | 1472 | 
                   | 
              
| 1394 | 
                  -=head2 C<create_query>  | 
              |
| 1395 | 
                  -  | 
              |
| 1396 | 
                  - my $query = $dbi->create_query(  | 
              |
| 1397 | 
                  -        "select * from books where {= author} and {like title};"
                 | 
              |
| 1398 | 
                  - );  | 
              |
| 1399 | 
                  -  | 
              |
| 1400 | 
                  -Create the instance of L<DBIx::Custom::Query> from the source of SQL.  | 
              |
| 1401 | 
                  -If you want to get high performance,  | 
              |
| 1402 | 
                  -use C<create_query()> method and execute it by C<execute()> method  | 
              |
| 1403 | 
                  -instead of suger methods.  | 
              |
| 1404 | 
                  -  | 
              |
| 1405 | 
                  -    $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
                 | 
              |
| 1406 | 
                  -  | 
              |
| 1407 | 
                  -=head2 C<execute>  | 
              |
| 1473 | 
                  +=head2 C<update>  | 
              |
| 1408 | 1474 | 
                   | 
              
| 1409 | 
                  - my $result = $dbi->execute($query, param => $params, filter => \%filter);  | 
              |
| 1410 | 
                  - my $result = $dbi->execute($source, param => $params, filter => \%filter);  | 
              |
| 1475 | 
                  + $dbi->update(table => $table,  | 
              |
| 1476 | 
                  + param => \%params,  | 
              |
| 1477 | 
                  + where => \%where,  | 
              |
| 1478 | 
                  + append => $append,  | 
              |
| 1479 | 
                  + filter => \%filter)  | 
              |
| 1411 | 1480 | 
                   | 
              
| 1412 | 
                  -Execute query or the source of SQL.  | 
              |
| 1413 | 
                  -Query is L<DBIx::Custom::Query> object.  | 
              |
| 1414 | 
                  -Return value is L<DBIx::Custom::Result> if select statement is executed,  | 
              |
| 1415 | 
                  -or the count of affected rows if insert, update, delete statement is executed.  | 
              |
| 1481 | 
                  +Execute update statement.  | 
              |
| 1482 | 
                  +C<update> method have C<table>, C<param>, C<where>, C<append>  | 
              |
| 1483 | 
                  +and C<filter> arguments.  | 
              |
| 1484 | 
                  +C<table> is a table name.  | 
              |
| 1485 | 
                  +C<param> is column-value pairs. this must be hash reference.  | 
              |
| 1486 | 
                  +C<where> is where clause. this must be hash reference.  | 
              |
| 1487 | 
                  +C<append> is a string added at the end of the SQL statement.  | 
              |
| 1488 | 
                  +C<filter> is filters when parameter binding is executed.  | 
              |
| 1489 | 
                  +This is overwrites C<default_bind_filter>.  | 
              |
| 1490 | 
                  +Return value of C<update()> is the count of affected rows.  | 
              |
| 1416 | 1491 | 
                   | 
              
| 1417 | 1492 | 
                  B<Example:>  | 
              
| 1418 | 1493 | 
                   | 
              
| 1419 | 
                  - my $result = $dbi->execute(  | 
              |
| 1420 | 
                  -        "select * from books where {= author} and {like title}", 
                 | 
              |
| 1421 | 
                  -        param => {author => 'Ken', title => '%Perl%'}
                 | 
              |
| 1422 | 
                  - );  | 
              |
| 1423 | 
                  -  | 
              |
| 1424 | 
                  -    while (my $row = $result->fetch) {
                 | 
              |
| 1425 | 
                  - my $author = $row->[0];  | 
              |
| 1426 | 
                  - my $title = $row->[1];  | 
              |
| 1427 | 
                  - }  | 
              |
| 1428 | 
                  -  | 
              |
| 1429 | 
                  -=head2 C<register_filter>  | 
              |
| 1430 | 
                  -  | 
              |
| 1431 | 
                  - $dbi->register_filter(%filters);  | 
              |
| 1432 | 
                  - $dbi->register_filter(\%filters);  | 
              |
| 1433 | 
                  -  | 
              |
| 1434 | 
                  -Register filter. Registered filters is available in the following attributes  | 
              |
| 1435 | 
                  -or arguments.  | 
              |
| 1436 | 
                  -  | 
              |
| 1437 | 
                  -=over 4  | 
              |
| 1438 | 
                  -  | 
              |
| 1439 | 
                  -=item *  | 
              |
| 1440 | 
                  -  | 
              |
| 1441 | 
                  -C<default_bind_filter>, C<default_fetch_filter>  | 
              |
| 1442 | 
                  -  | 
              |
| 1443 | 
                  -=item *  | 
              |
| 1444 | 
                  -  | 
              |
| 1445 | 
                  -C<filter> argument of C<insert()>, C<update()>,  | 
              |
| 1446 | 
                  -C<update_all()>, C<delete()>, C<delete_all()>, C<select()>  | 
              |
| 1447 | 
                  -methods  | 
              |
| 1448 | 
                  -  | 
              |
| 1449 | 
                  -=item *  | 
              |
| 1450 | 
                  -  | 
              |
| 1451 | 
                  -C<execute()> method  | 
              |
| 1452 | 
                  -  | 
              |
| 1453 | 
                  -=item *  | 
              |
| 1454 | 
                  -  | 
              |
| 1455 | 
                  -C<default_filter> and C<filter> of C<DBIx::Custom::Query>  | 
              |
| 1494 | 
                  + $dbi->update(table => 'books',  | 
              |
| 1495 | 
                  +                 param  => {title => 'Perl', author => 'Taro'},
                 | 
              |
| 1496 | 
                  +                 where  => {id => 5},
                 | 
              |
| 1497 | 
                  + append => "some statement",  | 
              |
| 1498 | 
                  +                 filter => {title => 'encode_utf8'});
                 | 
              |
| 1456 | 1499 | 
                   | 
              
| 1457 | 
                  -=item *  | 
              |
| 1500 | 
                  +=head2 C<update_all>  | 
              |
| 1458 | 1501 | 
                   | 
              
| 1459 | 
                  -C<default_filter> and C<filter> of C<DBIx::Custom::Result>  | 
              |
| 1502 | 
                  + $dbi->update_all(table => $table,  | 
              |
| 1503 | 
                  + param => \%params,  | 
              |
| 1504 | 
                  + filter => \%filter,  | 
              |
| 1505 | 
                  + append => $append);  | 
              |
| 1460 | 1506 | 
                   | 
              
| 1461 | 
                  -=back  | 
              |
| 1507 | 
                  +Execute update statement to update all rows.  | 
              |
| 1508 | 
                  +Arguments is same as C<update> method,  | 
              |
| 1509 | 
                  +except that C<update_all> don't have C<where> argument.  | 
              |
| 1510 | 
                  +Return value of C<update_all()> is the count of affected rows.  | 
              |
| 1462 | 1511 | 
                   | 
              
| 1463 | 1512 | 
                  B<Example:>  | 
              
| 1464 | 1513 | 
                   | 
              
| 1465 | 
                  - $dbi->register_filter(  | 
              |
| 1466 | 
                  -        encode_utf8 => sub {
                 | 
              |
| 1467 | 
                  - my $value = shift;  | 
              |
| 1468 | 
                  -  | 
              |
| 1469 | 
                  - require Encode;  | 
              |
| 1470 | 
                  -  | 
              |
| 1471 | 
                  -            return Encode::encode('UTF-8', $value);
                 | 
              |
| 1472 | 
                  - },  | 
              |
| 1473 | 
                  -        decode_utf8 => sub {
                 | 
              |
| 1474 | 
                  - my $value = shift;  | 
              |
| 1475 | 
                  -  | 
              |
| 1476 | 
                  - require Encode;  | 
              |
| 1477 | 
                  -  | 
              |
| 1478 | 
                  -            return Encode::decode('UTF-8', $value)
                 | 
              |
| 1479 | 
                  - }  | 
              |
| 1480 | 
                  - );  | 
              |
| 1514 | 
                  + $dbi->update_all(table => 'books',  | 
              |
| 1515 | 
                  +                     param  => {author => 'taro'},
                 | 
              |
| 1516 | 
                  +                     filter => {author => 'encode_utf8'});
                 | 
              |
| 1481 | 1517 | 
                   | 
              
| 1482 | 1518 | 
                  =head1 STABILITY  | 
              
| 1483 | 1519 | 
                   | 
              
| ... | ... | 
                  @@ -5,7 +5,7 @@ use warnings;  | 
              
| 5 | 5 | 
                   | 
              
| 6 | 6 | 
                  use base 'Object::Simple';  | 
              
| 7 | 7 | 
                   | 
              
| 8 | 
                  -__PACKAGE__->attr([qw/sql columns default_filter filter sth/]);  | 
              |
| 8 | 
                  +__PACKAGE__->attr([qw/columns default_filter filter sql sth/]);  | 
              |
| 9 | 9 | 
                   | 
              
| 10 | 10 | 
                  1;  | 
              
| 11 | 11 | 
                   | 
              
| ... | ... | 
                  @@ -19,13 +19,6 @@ DBIx::Custom::Query - Query  | 
              
| 19 | 19 | 
                   | 
              
| 20 | 20 | 
                  =head1 ATTRIBUTES  | 
              
| 21 | 21 | 
                   | 
              
| 22 | 
                  -=head2 C<sql>  | 
              |
| 23 | 
                  -  | 
              |
| 24 | 
                  - my $sql = $query->sql;  | 
              |
| 25 | 
                  -    $query  = $query->sql('select * from books where author = ?;');
                 | 
              |
| 26 | 
                  -  | 
              |
| 27 | 
                  -SQL statement.  | 
              |
| 28 | 
                  -  | 
              |
| 29 | 22 | 
                  =head2 C<columns>  | 
              
| 30 | 23 | 
                   | 
              
| 31 | 24 | 
                  my $columns = $query->columns;  | 
              
| ... | ... | 
                  @@ -49,6 +42,13 @@ Default filter when parameter binding is executed.  | 
              
| 49 | 42 | 
                  Filters when parameter binding is executed.  | 
              
| 50 | 43 | 
                  This overwrites C<default_filter>.  | 
              
| 51 | 44 | 
                   | 
              
| 45 | 
                  +=head2 C<sql>  | 
              |
| 46 | 
                  +  | 
              |
| 47 | 
                  + my $sql = $query->sql;  | 
              |
| 48 | 
                  +    $query  = $query->sql('select * from books where author = ?;');
                 | 
              |
| 49 | 
                  +  | 
              |
| 50 | 
                  +SQL statement.  | 
              |
| 51 | 
                  +  | 
              |
| 52 | 52 | 
                  =head2 C<sth>  | 
              
| 53 | 53 | 
                   | 
              
| 54 | 54 | 
                  my $sth = $query->sth;  | 
              
| ... | ... | 
                  @@ -12,7 +12,10 @@ use DBIx::Custom::QueryBuilder::TagProcessors;  | 
              
| 12 | 12 | 
                  # Carp trust relationship  | 
              
| 13 | 13 | 
                  push @DBIx::Custom::CARP_NOT, __PACKAGE__;  | 
              
| 14 | 14 | 
                   | 
              
| 15 | 
                  +# Attributes  | 
              |
| 15 | 16 | 
                   __PACKAGE__->dual_attr('tag_processors', default => sub { {} }, inherit => 'hash_copy');
                 | 
              
| 17 | 
                  +  | 
              |
| 18 | 
                  +# Resister tag processor  | 
              |
| 16 | 19 | 
                  __PACKAGE__->register_tag_processor(  | 
              
| 17 | 20 | 
                  '?' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_placeholder_tag,  | 
              
| 18 | 21 | 
                  '=' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_equal_tag,  | 
              
| ... | ... | 
                  @@ -27,6 +30,18 @@ __PACKAGE__->register_tag_processor(  | 
              
| 27 | 30 | 
                  'update_param' => \&DBIx::Custom::QueryBuilder::TagProcessors::expand_update_param_tag  | 
              
| 28 | 31 | 
                  );  | 
              
| 29 | 32 | 
                   | 
              
| 33 | 
                  +sub build_query {
                 | 
              |
| 34 | 
                  + my ($self, $source) = @_;  | 
              |
| 35 | 
                  +  | 
              |
| 36 | 
                  + # Parse  | 
              |
| 37 | 
                  + my $tree = $self->_parse($source);  | 
              |
| 38 | 
                  +  | 
              |
| 39 | 
                  + # Build query  | 
              |
| 40 | 
                  + my $query = $self->_build_query($tree);  | 
              |
| 41 | 
                  +  | 
              |
| 42 | 
                  + return $query;  | 
              |
| 43 | 
                  +}  | 
              |
| 44 | 
                  +  | 
              |
| 30 | 45 | 
                   sub register_tag_processor {
                 | 
              
| 31 | 46 | 
                  my $self = shift;  | 
              
| 32 | 47 | 
                   | 
              
| ... | ... | 
                  @@ -37,14 +52,70 @@ sub register_tag_processor {
                 | 
              
| 37 | 52 | 
                  return $self;  | 
              
| 38 | 53 | 
                  }  | 
              
| 39 | 54 | 
                   | 
              
| 40 | 
                  -sub build_query {
                 | 
              |
| 41 | 
                  - my ($self, $source) = @_;  | 
              |
| 55 | 
                  +sub _build_query {
                 | 
              |
| 56 | 
                  + my ($self, $tree) = @_;  | 
              |
| 42 | 57 | 
                   | 
              
| 43 | 
                  - # Parse  | 
              |
| 44 | 
                  - my $tree = $self->_parse($source);  | 
              |
| 58 | 
                  + # SQL  | 
              |
| 59 | 
                  + my $sql = '';  | 
              |
| 45 | 60 | 
                   | 
              
| 46 | 
                  - # Build query  | 
              |
| 47 | 
                  - my $query = $self->_build_query($tree);  | 
              |
| 61 | 
                  + # All Columns  | 
              |
| 62 | 
                  + my $all_columns = [];  | 
              |
| 63 | 
                  +  | 
              |
| 64 | 
                  + # Build SQL  | 
              |
| 65 | 
                  +    foreach my $node (@$tree) {
                 | 
              |
| 66 | 
                  +  | 
              |
| 67 | 
                  + # Text  | 
              |
| 68 | 
                  +        if ($node->{type} eq 'text') { $sql .= $node->{value} }
                 | 
              |
| 69 | 
                  +  | 
              |
| 70 | 
                  + # Tag  | 
              |
| 71 | 
                  +        else {
                 | 
              |
| 72 | 
                  +  | 
              |
| 73 | 
                  + # Tag name  | 
              |
| 74 | 
                  +            my $tag_name = $node->{tag_name};
                 | 
              |
| 75 | 
                  +  | 
              |
| 76 | 
                  + # Tag arguments  | 
              |
| 77 | 
                  +            my $tag_args = $node->{tag_args};
                 | 
              |
| 78 | 
                  +  | 
              |
| 79 | 
                  + # Get tag processor  | 
              |
| 80 | 
                  +            my $tag_processor = $self->tag_processors->{$tag_name};
                 | 
              |
| 81 | 
                  +  | 
              |
| 82 | 
                  + # Tag processor is not registered  | 
              |
| 83 | 
                  +            croak qq{Tag "$tag_name" in "{a }" is not registered}
                 | 
              |
| 84 | 
                  + unless $tag_processor;  | 
              |
| 85 | 
                  +  | 
              |
| 86 | 
                  + # Tag processor not sub reference  | 
              |
| 87 | 
                  +            croak qq{Tag processor "$tag_name" must be sub reference}
                 | 
              |
| 88 | 
                  + unless ref $tag_processor eq 'CODE';  | 
              |
| 89 | 
                  +  | 
              |
| 90 | 
                  + # Execute tag processor  | 
              |
| 91 | 
                  + my $r = $tag_processor->(@$tag_args);  | 
              |
| 92 | 
                  +  | 
              |
| 93 | 
                  + # Check tag processor return value  | 
              |
| 94 | 
                  +            croak qq{Tag processor "$tag_name" must return [STRING, ARRAY_REFERENCE]}
                 | 
              |
| 95 | 
                  + unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';  | 
              |
| 96 | 
                  +  | 
              |
| 97 | 
                  + # Part of SQL statement and colum names  | 
              |
| 98 | 
                  + my ($part, $columns) = @$r;  | 
              |
| 99 | 
                  +  | 
              |
| 100 | 
                  + # Add columns  | 
              |
| 101 | 
                  + push @$all_columns, @$columns;  | 
              |
| 102 | 
                  +  | 
              |
| 103 | 
                  + # Join part tag to SQL  | 
              |
| 104 | 
                  + $sql .= $part;  | 
              |
| 105 | 
                  + }  | 
              |
| 106 | 
                  + }  | 
              |
| 107 | 
                  +  | 
              |
| 108 | 
                  + # Check placeholder count  | 
              |
| 109 | 
                  + my $placeholder_count = $self->_placeholder_count($sql);  | 
              |
| 110 | 
                  + my $column_count = @$all_columns;  | 
              |
| 111 | 
                  +    croak qq{Placeholder count in "$sql" must be same as column count $column_count}
                 | 
              |
| 112 | 
                  + unless $placeholder_count eq @$all_columns;  | 
              |
| 113 | 
                  +  | 
              |
| 114 | 
                  + # Add semicolon  | 
              |
| 115 | 
                  + $sql .= ';' unless $sql =~ /;$/;  | 
              |
| 116 | 
                  +  | 
              |
| 117 | 
                  + # Query  | 
              |
| 118 | 
                  + my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);  | 
              |
| 48 | 119 | 
                   | 
              
| 49 | 120 | 
                  return $query;  | 
              
| 50 | 121 | 
                  }  | 
              
| ... | ... | 
                  @@ -190,74 +261,6 @@ sub _parse {
                 | 
              
| 190 | 261 | 
                  return \@tree;  | 
              
| 191 | 262 | 
                  }  | 
              
| 192 | 263 | 
                   | 
              
| 193 | 
                  -sub _build_query {
                 | 
              |
| 194 | 
                  - my ($self, $tree) = @_;  | 
              |
| 195 | 
                  -  | 
              |
| 196 | 
                  - # SQL  | 
              |
| 197 | 
                  - my $sql = '';  | 
              |
| 198 | 
                  -  | 
              |
| 199 | 
                  - # All Columns  | 
              |
| 200 | 
                  - my $all_columns = [];  | 
              |
| 201 | 
                  -  | 
              |
| 202 | 
                  - # Build SQL  | 
              |
| 203 | 
                  -    foreach my $node (@$tree) {
                 | 
              |
| 204 | 
                  -  | 
              |
| 205 | 
                  - # Text  | 
              |
| 206 | 
                  -        if ($node->{type} eq 'text') { $sql .= $node->{value} }
                 | 
              |
| 207 | 
                  -  | 
              |
| 208 | 
                  - # Tag  | 
              |
| 209 | 
                  -        else {
                 | 
              |
| 210 | 
                  -  | 
              |
| 211 | 
                  - # Tag name  | 
              |
| 212 | 
                  -            my $tag_name = $node->{tag_name};
                 | 
              |
| 213 | 
                  -  | 
              |
| 214 | 
                  - # Tag arguments  | 
              |
| 215 | 
                  -            my $tag_args = $node->{tag_args};
                 | 
              |
| 216 | 
                  -  | 
              |
| 217 | 
                  - # Get tag processor  | 
              |
| 218 | 
                  -            my $tag_processor = $self->tag_processors->{$tag_name};
                 | 
              |
| 219 | 
                  -  | 
              |
| 220 | 
                  - # Tag processor is not registered  | 
              |
| 221 | 
                  -            croak qq{Tag "$tag_name" in "{a }" is not registered}
                 | 
              |
| 222 | 
                  - unless $tag_processor;  | 
              |
| 223 | 
                  -  | 
              |
| 224 | 
                  - # Tag processor not sub reference  | 
              |
| 225 | 
                  -            croak qq{Tag processor "$tag_name" must be sub reference}
                 | 
              |
| 226 | 
                  - unless ref $tag_processor eq 'CODE';  | 
              |
| 227 | 
                  -  | 
              |
| 228 | 
                  - # Execute tag processor  | 
              |
| 229 | 
                  - my $r = $tag_processor->(@$tag_args);  | 
              |
| 230 | 
                  -  | 
              |
| 231 | 
                  - # Check tag processor return value  | 
              |
| 232 | 
                  -            croak qq{Tag processor "$tag_name" must return [STRING, ARRAY_REFERENCE]}
                 | 
              |
| 233 | 
                  - unless ref $r eq 'ARRAY' && defined $r->[0] && ref $r->[1] eq 'ARRAY';  | 
              |
| 234 | 
                  -  | 
              |
| 235 | 
                  - # Part of SQL statement and colum names  | 
              |
| 236 | 
                  - my ($part, $columns) = @$r;  | 
              |
| 237 | 
                  -  | 
              |
| 238 | 
                  - # Add columns  | 
              |
| 239 | 
                  - push @$all_columns, @$columns;  | 
              |
| 240 | 
                  -  | 
              |
| 241 | 
                  - # Join part tag to SQL  | 
              |
| 242 | 
                  - $sql .= $part;  | 
              |
| 243 | 
                  - }  | 
              |
| 244 | 
                  - }  | 
              |
| 245 | 
                  -  | 
              |
| 246 | 
                  - # Check placeholder count  | 
              |
| 247 | 
                  - my $placeholder_count = $self->_placeholder_count($sql);  | 
              |
| 248 | 
                  - my $column_count = @$all_columns;  | 
              |
| 249 | 
                  -    croak qq{Placeholder count in "$sql" must be same as column count $column_count}
                 | 
              |
| 250 | 
                  - unless $placeholder_count eq @$all_columns;  | 
              |
| 251 | 
                  -  | 
              |
| 252 | 
                  - # Add semicolon  | 
              |
| 253 | 
                  - $sql .= ';' unless $sql =~ /;$/;  | 
              |
| 254 | 
                  -  | 
              |
| 255 | 
                  - # Query  | 
              |
| 256 | 
                  - my $query = DBIx::Custom::Query->new(sql => $sql, columns => $all_columns);  | 
              |
| 257 | 
                  -  | 
              |
| 258 | 
                  - return $query;  | 
              |
| 259 | 
                  -}  | 
              |
| 260 | 
                  -  | 
              |
| 261 | 264 | 
                   sub _placeholder_count {
                 | 
              
| 262 | 265 | 
                  my ($self, $expand) = @_;  | 
              
| 263 | 266 | 
                   | 
              
| ... | ... | 
                  @@ -8,33 +8,9 @@ use Carp 'croak';  | 
              
| 8 | 8 | 
                  # Carp trust relationship  | 
              
| 9 | 9 | 
                  push @DBIx::Custom::QueryBuilder::CARP_NOT, __PACKAGE__;  | 
              
| 10 | 10 | 
                   | 
              
| 11 | 
                  -sub _expand_basic_tag {
                 | 
              |
| 12 | 
                  - my ($name, $column) = @_;  | 
              |
| 13 | 
                  -  | 
              |
| 14 | 
                  - # Check arguments  | 
              |
| 15 | 
                  -    croak qq{Column name must be specified in tag "{$name }"}
                 | 
              |
| 16 | 
                  - unless $column;  | 
              |
| 17 | 
                  -  | 
              |
| 18 | 
                  - return ["$column $name ?", [$column]];  | 
              |
| 19 | 
                  -}  | 
              |
| 20 | 
                  -  | 
              |
| 21 | 11 | 
                   sub expand_equal_tag              { _expand_basic_tag('=',    @_) }
                 | 
              
| 22 | 
                  -sub expand_not_equal_tag          { _expand_basic_tag('<>',   @_) }
                 | 
              |
| 23 | 
                  -sub expand_greater_than_tag       { _expand_basic_tag('>',    @_) }
                 | 
              |
| 24 | 
                  -sub expand_lower_than_tag         { _expand_basic_tag('<',    @_) }
                 | 
              |
| 25 | 12 | 
                   sub expand_greater_than_equal_tag { _expand_basic_tag('>=',   @_) }
                 | 
              
| 26 | 
                  -sub expand_lower_than_equal_tag   { _expand_basic_tag('<=',   @_) }
                 | 
              |
| 27 | 
                  -sub expand_like_tag               { _expand_basic_tag('like', @_) }
                 | 
              |
| 28 | 
                  -  | 
              |
| 29 | 
                  -sub expand_placeholder_tag {
                 | 
              |
| 30 | 
                  - my $column = shift;  | 
              |
| 31 | 
                  -  | 
              |
| 32 | 
                  - # Check arguments  | 
              |
| 33 | 
                  -    croak qq{Column name must be specified in tag "{? }"}
                 | 
              |
| 34 | 
                  - unless $column;  | 
              |
| 35 | 
                  -  | 
              |
| 36 | 
                  - return ['?', [$column]];  | 
              |
| 37 | 
                  -}  | 
              |
| 13 | 
                  +sub expand_greater_than_tag       { _expand_basic_tag('>',    @_) }
                 | 
              |
| 38 | 14 | 
                   | 
              
| 39 | 15 | 
                   sub expand_in_tag {
                 | 
              
| 40 | 16 | 
                  my ($column, $count) = @_;  | 
              
| ... | ... | 
                  @@ -74,6 +50,21 @@ sub expand_insert_param_tag {
                 | 
              
| 74 | 50 | 
                  return [$s, \@columns];  | 
              
| 75 | 51 | 
                  }  | 
              
| 76 | 52 | 
                   | 
              
| 53 | 
                  +sub expand_like_tag               { _expand_basic_tag('like', @_) }
                 | 
              |
| 54 | 
                  +sub expand_lower_than_equal_tag   { _expand_basic_tag('<=',   @_) }
                 | 
              |
| 55 | 
                  +sub expand_lower_than_tag         { _expand_basic_tag('<',    @_) }
                 | 
              |
| 56 | 
                  +sub expand_not_equal_tag          { _expand_basic_tag('<>',   @_) }
                 | 
              |
| 57 | 
                  +  | 
              |
| 58 | 
                  +sub expand_placeholder_tag {
                 | 
              |
| 59 | 
                  + my $column = shift;  | 
              |
| 60 | 
                  +  | 
              |
| 61 | 
                  + # Check arguments  | 
              |
| 62 | 
                  +    croak qq{Column name must be specified in tag "{? }"}
                 | 
              |
| 63 | 
                  + unless $column;  | 
              |
| 64 | 
                  +  | 
              |
| 65 | 
                  + return ['?', [$column]];  | 
              |
| 66 | 
                  +}  | 
              |
| 67 | 
                  +  | 
              |
| 77 | 68 | 
                   sub expand_update_param_tag {
                 | 
              
| 78 | 69 | 
                  my @columns = @_;  | 
              
| 79 | 70 | 
                   | 
              
| ... | ... | 
                  @@ -85,6 +76,16 @@ sub expand_update_param_tag {
                 | 
              
| 85 | 76 | 
                  return [$s, \@columns];  | 
              
| 86 | 77 | 
                  }  | 
              
| 87 | 78 | 
                   | 
              
| 79 | 
                  +sub _expand_basic_tag {
                 | 
              |
| 80 | 
                  + my ($name, $column) = @_;  | 
              |
| 81 | 
                  +  | 
              |
| 82 | 
                  + # Check arguments  | 
              |
| 83 | 
                  +    croak qq{Column name must be specified in tag "{$name }"}
                 | 
              |
| 84 | 
                  + unless $column;  | 
              |
| 85 | 
                  +  | 
              |
| 86 | 
                  + return ["$column $name ?", [$column]];  | 
              |
| 87 | 
                  +}  | 
              |
| 88 | 
                  +  | 
              |
| 88 | 89 | 
                  1;  | 
              
| 89 | 90 | 
                   | 
              
| 90 | 91 | 
                  =head1 NAME  | 
              
| ... | ... | 
                  @@ -115,37 +116,29 @@ same as the count of column names.  | 
              
| 115 | 116 | 
                  return [$s, $columns];  | 
              
| 116 | 117 | 
                  }  | 
              
| 117 | 118 | 
                   | 
              
| 118 | 
                  -=head2 C<expand_placeholder_tag>  | 
              |
| 119 | 
                  -  | 
              |
| 120 | 
                  -    ('NAME')  ->  ['?', ['NAME']]
                 | 
              |
| 121 | 
                  -  | 
              |
| 122 | 119 | 
                  =head2 C<expand_equal_tag>  | 
              
| 123 | 120 | 
                   | 
              
| 124 | 121 | 
                       ('NAME')  ->  ['NAME = ?', ['NAME']]
                 | 
              
| 125 | 122 | 
                   | 
              
| 126 | 
                  -=head2 C<expand_not_equal_tag>  | 
              |
| 123 | 
                  +=head2 C<expand_greater_than_equal_tag>  | 
              |
| 127 | 124 | 
                   | 
              
| 128 | 
                  -    ('NAME')  ->  ['NAME <> ?', ['NAME']]
                 | 
              |
| 125 | 
                  +    ('NAME')  ->  ['NAME >= ?', ['NAME']]
                 | 
              |
| 129 | 126 | 
                   | 
              
| 130 | 127 | 
                  =head2 C<expand_greater_than_tag>  | 
              
| 131 | 128 | 
                   | 
              
| 132 | 129 | 
                       ('NAME')  ->  ['NAME > ?', ['NAME']]
                 | 
              
| 133 | 130 | 
                   | 
              
| 134 | 
                  -=head2 C<expand_lower_than_tag>  | 
              |
| 135 | 
                  -  | 
              |
| 136 | 
                  -    ('NAME')  ->  ['NAME < ?', ['NAME']]
                 | 
              |
| 137 | 
                  -  | 
              |
| 138 | 
                  -=head2 C<expand_greater_than_equal_tag>  | 
              |
| 131 | 
                  +=head2 C<expand_like_tag>  | 
              |
| 139 | 132 | 
                   | 
              
| 140 | 
                  -    ('NAME')  ->  ['NAME >= ?', ['NAME']]
                 | 
              |
| 133 | 
                  +    ('NAME')  ->  ['NAME like ?', ['NAME']]
                 | 
              |
| 141 | 134 | 
                   | 
              
| 142 | 135 | 
                  =head2 C<expand_lower_than_equal_tag>  | 
              
| 143 | 136 | 
                   | 
              
| 144 | 137 | 
                       ('NAME')  ->  ['NAME <= ?', ['NAME']]
                 | 
              
| 145 | 138 | 
                   | 
              
| 146 | 
                  -=head2 C<expand_like_tag>  | 
              |
| 139 | 
                  +=head2 C<expand_lower_than_tag>  | 
              |
| 147 | 140 | 
                   | 
              
| 148 | 
                  -    ('NAME')  ->  ['NAME like ?', ['NAME']]
                 | 
              |
| 141 | 
                  +    ('NAME')  ->  ['NAME < ?', ['NAME']]
                 | 
              |
| 149 | 142 | 
                   | 
              
| 150 | 143 | 
                  =head2 C<expand_in_tag>  | 
              
| 151 | 144 | 
                   | 
              
| ... | ... | 
                  @@ -156,6 +149,14 @@ same as the count of column names.  | 
              
| 156 | 149 | 
                       ('NAME1', 'NAME2')
                 | 
              
| 157 | 150 | 
                  -> ['(NAME1, NAME2) values (?, ?, ?)', ['NAME1', 'NAME2']]  | 
              
| 158 | 151 | 
                   | 
              
| 152 | 
                  +=head2 C<expand_not_equal_tag>  | 
              |
| 153 | 
                  +  | 
              |
| 154 | 
                  +    ('NAME')  ->  ['NAME <> ?', ['NAME']]
                 | 
              |
| 155 | 
                  +  | 
              |
| 156 | 
                  +=head2 C<expand_placeholder_tag>  | 
              |
| 157 | 
                  +  | 
              |
| 158 | 
                  +    ('NAME')  ->  ['?', ['NAME']]
                 | 
              |
| 159 | 
                  +  | 
              |
| 159 | 160 | 
                  =head2 C<expand_update_param_tag>  | 
              
| 160 | 161 | 
                   | 
              
| 161 | 162 | 
                       ('NAME1', 'NAME2')
                 | 
              
| ... | ... | 
                  @@ -7,7 +7,7 @@ use base 'Object::Simple';  | 
              
| 7 | 7 | 
                   | 
              
| 8 | 8 | 
                  use Carp 'croak';  | 
              
| 9 | 9 | 
                   | 
              
| 10 | 
                  -__PACKAGE__->attr([qw/sth filters default_filter filter filter_check/]);  | 
              |
| 10 | 
                  +__PACKAGE__->attr([qw/default_filter filter filter_check filters sth/]);  | 
              |
| 11 | 11 | 
                   | 
              
| 12 | 12 | 
                   sub fetch {
                 | 
              
| 13 | 13 | 
                  my $self = shift;  | 
              
| ... | ... | 
                  @@ -45,6 +45,17 @@ sub fetch {
                 | 
              
| 45 | 45 | 
                  return \@row;  | 
              
| 46 | 46 | 
                  }  | 
              
| 47 | 47 | 
                   | 
              
| 48 | 
                  +sub fetch_all {
                 | 
              |
| 49 | 
                  + my $self = shift;  | 
              |
| 50 | 
                  +  | 
              |
| 51 | 
                  + # Fetch all rows  | 
              |
| 52 | 
                  + my $rows = [];  | 
              |
| 53 | 
                  +    while(my $row = $self->fetch) {
                 | 
              |
| 54 | 
                  + push @$rows, $row;  | 
              |
| 55 | 
                  + }  | 
              |
| 56 | 
                  + return $rows;  | 
              |
| 57 | 
                  +}  | 
              |
| 58 | 
                  +  | 
              |
| 48 | 59 | 
                   sub fetch_first {
                 | 
              
| 49 | 60 | 
                  my $self = shift;  | 
              
| 50 | 61 | 
                   | 
              
| ... | ... | 
                  @@ -60,36 +71,6 @@ sub fetch_first {
                 | 
              
| 60 | 71 | 
                  return $row;  | 
              
| 61 | 72 | 
                  }  | 
              
| 62 | 73 | 
                   | 
              
| 63 | 
                  -sub fetch_multi {
                 | 
              |
| 64 | 
                  - my ($self, $count) = @_;  | 
              |
| 65 | 
                  -  | 
              |
| 66 | 
                  - # Row count not specifed  | 
              |
| 67 | 
                  - croak 'Row count must be specified'  | 
              |
| 68 | 
                  - unless $count;  | 
              |
| 69 | 
                  -  | 
              |
| 70 | 
                  - # Fetch multi rows  | 
              |
| 71 | 
                  - my $rows = [];  | 
              |
| 72 | 
                  -    for (my $i = 0; $i < $count; $i++) {
                 | 
              |
| 73 | 
                  - my $row = $self->fetch;  | 
              |
| 74 | 
                  - last unless $row;  | 
              |
| 75 | 
                  - push @$rows, $row;  | 
              |
| 76 | 
                  - }  | 
              |
| 77 | 
                  -  | 
              |
| 78 | 
                  - return unless @$rows;  | 
              |
| 79 | 
                  - return $rows;  | 
              |
| 80 | 
                  -}  | 
              |
| 81 | 
                  -  | 
              |
| 82 | 
                  -sub fetch_all {
                 | 
              |
| 83 | 
                  - my $self = shift;  | 
              |
| 84 | 
                  -  | 
              |
| 85 | 
                  - # Fetch all rows  | 
              |
| 86 | 
                  - my $rows = [];  | 
              |
| 87 | 
                  -    while(my $row = $self->fetch) {
                 | 
              |
| 88 | 
                  - push @$rows, $row;  | 
              |
| 89 | 
                  - }  | 
              |
| 90 | 
                  - return $rows;  | 
              |
| 91 | 
                  -}  | 
              |
| 92 | 
                  -  | 
              |
| 93 | 74 | 
                   sub fetch_hash {
                 | 
              
| 94 | 75 | 
                  my $self = shift;  | 
              
| 95 | 76 | 
                   | 
              
| ... | ... | 
                  @@ -128,6 +109,18 @@ sub fetch_hash {
                 | 
              
| 128 | 109 | 
                  return $row_hash;  | 
              
| 129 | 110 | 
                  }  | 
              
| 130 | 111 | 
                   | 
              
| 112 | 
                  +sub fetch_hash_all {
                 | 
              |
| 113 | 
                  + my $self = shift;  | 
              |
| 114 | 
                  +  | 
              |
| 115 | 
                  + # Fetch all rows as hash  | 
              |
| 116 | 
                  + my $rows = [];  | 
              |
| 117 | 
                  +    while(my $row = $self->fetch_hash) {
                 | 
              |
| 118 | 
                  + push @$rows, $row;  | 
              |
| 119 | 
                  + }  | 
              |
| 120 | 
                  +  | 
              |
| 121 | 
                  + return $rows;  | 
              |
| 122 | 
                  +}  | 
              |
| 123 | 
                  +  | 
              |
| 131 | 124 | 
                   sub fetch_hash_first {
                 | 
              
| 132 | 125 | 
                  my $self = shift;  | 
              
| 133 | 126 | 
                   | 
              
| ... | ... | 
                  @@ -162,15 +155,22 @@ sub fetch_hash_multi {
                 | 
              
| 162 | 155 | 
                  return $rows;  | 
              
| 163 | 156 | 
                  }  | 
              
| 164 | 157 | 
                   | 
              
| 165 | 
                  -sub fetch_hash_all {
                 | 
              |
| 166 | 
                  - my $self = shift;  | 
              |
| 158 | 
                  +sub fetch_multi {
                 | 
              |
| 159 | 
                  + my ($self, $count) = @_;  | 
              |
| 167 | 160 | 
                   | 
              
| 168 | 
                  - # Fetch all rows as hash  | 
              |
| 161 | 
                  + # Row count not specifed  | 
              |
| 162 | 
                  + croak 'Row count must be specified'  | 
              |
| 163 | 
                  + unless $count;  | 
              |
| 164 | 
                  +  | 
              |
| 165 | 
                  + # Fetch multi rows  | 
              |
| 169 | 166 | 
                  my $rows = [];  | 
              
| 170 | 
                  -    while(my $row = $self->fetch_hash) {
                 | 
              |
| 167 | 
                  +    for (my $i = 0; $i < $count; $i++) {
                 | 
              |
| 168 | 
                  + my $row = $self->fetch;  | 
              |
| 169 | 
                  + last unless $row;  | 
              |
| 171 | 170 | 
                  push @$rows, $row;  | 
              
| 172 | 171 | 
                  }  | 
              
| 173 | 172 | 
                   | 
              
| 173 | 
                  + return unless @$rows;  | 
              |
| 174 | 174 | 
                  return $rows;  | 
              
| 175 | 175 | 
                  }  | 
              
| 176 | 176 | 
                   | 
              
| ... | ... | 
                  @@ -261,13 +261,6 @@ Fetch row into hash.  | 
              
| 261 | 261 | 
                   | 
              
| 262 | 262 | 
                  =head1 ATTRIBUTES  | 
              
| 263 | 263 | 
                   | 
              
| 264 | 
                  -=head2 C<sth>  | 
              |
| 265 | 
                  -  | 
              |
| 266 | 
                  - my $sth = $reuslt->sth  | 
              |
| 267 | 
                  - $result = $result->sth($sth);  | 
              |
| 268 | 
                  -  | 
              |
| 269 | 
                  -Statement handle of L<DBI>.  | 
              |
| 270 | 
                  -  | 
              |
| 271 | 264 | 
                  =head2 C<default_filter>  | 
              
| 272 | 265 | 
                   | 
              
| 273 | 266 | 
                  my $default_filter = $result->default_filter;  | 
              
| ... | ... | 
                  @@ -284,6 +277,27 @@ Default filter when a row is fetched.  | 
              
| 284 | 277 | 
                  Filters when a row is fetched.  | 
              
| 285 | 278 | 
                  This overwrites C<default_filter>.  | 
              
| 286 | 279 | 
                   | 
              
| 280 | 
                  +=head2 C<filters>  | 
              |
| 281 | 
                  +  | 
              |
| 282 | 
                  + my $filters = $result->filters;  | 
              |
| 283 | 
                  + $result = $result->filters(\%filters);  | 
              |
| 284 | 
                  +  | 
              |
| 285 | 
                  +Resistered filters.  | 
              |
| 286 | 
                  +  | 
              |
| 287 | 
                  +=head2 C<filter_check>  | 
              |
| 288 | 
                  +  | 
              |
| 289 | 
                  + my $filter_check = $result->filter_check;  | 
              |
| 290 | 
                  + $result = $result->filter_check;  | 
              |
| 291 | 
                  +  | 
              |
| 292 | 
                  +Enable filter validation.  | 
              |
| 293 | 
                  +  | 
              |
| 294 | 
                  +=head2 C<sth>  | 
              |
| 295 | 
                  +  | 
              |
| 296 | 
                  + my $sth = $reuslt->sth  | 
              |
| 297 | 
                  + $result = $result->sth($sth);  | 
              |
| 298 | 
                  +  | 
              |
| 299 | 
                  +Statement handle of L<DBI>.  | 
              |
| 300 | 
                  +  | 
              |
| 287 | 301 | 
                  =head1 METHODS  | 
              
| 288 | 302 | 
                   | 
              
| 289 | 303 | 
                  L<DBIx::Custom::Result> inherits all methods from L<Object::Simple>  | 
              
| ... | ... | 
                  @@ -295,31 +309,30 @@ and implements the following new ones.  | 
              
| 295 | 309 | 
                   | 
              
| 296 | 310 | 
                  Fetch a row into array.  | 
              
| 297 | 311 | 
                   | 
              
| 298 | 
                  -=head2 C<fetch_first>  | 
              |
| 299 | 
                  -  | 
              |
| 300 | 
                  - my $row = $result->fetch_first;  | 
              |
| 301 | 
                  -  | 
              |
| 302 | 
                  -Fetch only a first row into array and finish statment handle.  | 
              |
| 303 | 
                  -  | 
              |
| 304 | 
                  -=head2 C<fetch_multi>  | 
              |
| 305 | 
                  -  | 
              |
| 306 | 
                  - my $rows = $result->fetch_multi(5);  | 
              |
| 307 | 
                  -  | 
              |
| 308 | 
                  -Fetch multiple rows into array of array.  | 
              |
| 309 | 
                  -Row count must be specified.  | 
              |
| 310 | 
                  -  | 
              |
| 311 | 312 | 
                  =head2 C<fetch_all>  | 
              
| 312 | 313 | 
                   | 
              
| 313 | 314 | 
                  my $rows = $result->fetch_all;  | 
              
| 314 | 315 | 
                   | 
              
| 315 | 316 | 
                  Fetch all rows into array of array.  | 
              
| 316 | 317 | 
                   | 
              
| 318 | 
                  +=head2 C<fetch_first>  | 
              |
| 319 | 
                  +  | 
              |
| 320 | 
                  + my $row = $result->fetch_first;  | 
              |
| 321 | 
                  +  | 
              |
| 322 | 
                  +Fetch only a first row into array and finish statment handle.  | 
              |
| 323 | 
                  +  | 
              |
| 317 | 324 | 
                  =head2 C<fetch_hash>  | 
              
| 318 | 325 | 
                   | 
              
| 319 | 326 | 
                  my $row = $result->fetch_hash;  | 
              
| 320 | 327 | 
                   | 
              
| 321 | 328 | 
                  Fetch a row into hash  | 
              
| 322 | 329 | 
                   | 
              
| 330 | 
                  +=head2 C<fetch_hash_all>  | 
              |
| 331 | 
                  +  | 
              |
| 332 | 
                  + my $rows = $result->fetch_hash_all;  | 
              |
| 333 | 
                  +  | 
              |
| 334 | 
                  +Fetch all rows into array of hash.  | 
              |
| 335 | 
                  +  | 
              |
| 323 | 336 | 
                  =head2 C<fetch_hash_first>  | 
              
| 324 | 337 | 
                   | 
              
| 325 | 338 | 
                  my $row = $result->fetch_hash_first;  | 
              
| ... | ... | 
                  @@ -333,10 +346,11 @@ Fetch only first row into hash and finish statment handle.  | 
              
| 333 | 346 | 
                  Fetch multiple rows into array of hash  | 
              
| 334 | 347 | 
                  Row count must be specified.  | 
              
| 335 | 348 | 
                   | 
              
| 336 | 
                  -=head2 C<fetch_hash_all>  | 
              |
| 337 | 
                  -  | 
              |
| 338 | 
                  - my $rows = $result->fetch_hash_all;  | 
              |
| 349 | 
                  +=head2 C<fetch_multi>  | 
              |
| 339 | 350 | 
                   | 
              
| 340 | 
                  -Fetch all rows into array of hash.  | 
              |
| 351 | 
                  + my $rows = $result->fetch_multi(5);  | 
              |
| 352 | 
                  +  | 
              |
| 353 | 
                  +Fetch multiple rows into array of array.  | 
              |
| 354 | 
                  +Row count must be specified.  | 
              |
| 341 | 355 | 
                   | 
              
| 342 | 356 | 
                  =cut  | 
              
| ... | ... | 
                  @@ -21,8 +21,6 @@ sub test {
                 | 
              
| 21 | 21 | 
                  $test = shift;  | 
              
| 22 | 22 | 
                  }  | 
              
| 23 | 23 | 
                   | 
              
| 24 | 
                  -use DBIx::Custom::SQLite;  | 
              |
| 25 | 
                  -  | 
              |
| 26 | 24 | 
                  # Constant varialbes for test  | 
              
| 27 | 25 | 
                   my $CREATE_TABLE = {
                 | 
              
| 28 | 26 | 
                  0 => 'create table table1 (key1 char(255), key2 char(255));',  | 
              
| ... | ... | 
                  @@ -572,3 +570,41 @@ ok($@, "$test: execute fail");  | 
              
| 572 | 570 | 
                       eval{$dbi->create_query('select * from table1 where {0 key1}')};
                 | 
              
| 573 | 571 | 
                  like($@, qr/QueryBuilder.*\.t /s, "$test : caller spec : not vebose");  | 
              
| 574 | 572 | 
                  }  | 
              
| 573 | 
                  +  | 
              |
| 574 | 
                  +  | 
              |
| 575 | 
                  +test 'transaction';  | 
              |
| 576 | 
                  +$dbi = DBIx::Custom->connect($NEW_ARGS->{0});
                 | 
              |
| 577 | 
                  +$dbi->execute($CREATE_TABLE->{0});
                 | 
              |
| 578 | 
                  +  | 
              |
| 579 | 
                  +$dbi->begin_work;  | 
              |
| 580 | 
                  +  | 
              |
| 581 | 
                  +eval {
                 | 
              |
| 582 | 
                  +    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
                 | 
              |
| 583 | 
                  + die "Error";  | 
              |
| 584 | 
                  +    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
                 | 
              |
| 585 | 
                  +};  | 
              |
| 586 | 
                  +  | 
              |
| 587 | 
                  +$dbi->rollback if $@;  | 
              |
| 588 | 
                  +  | 
              |
| 589 | 
                  +$result = $dbi->select(table => 'table1');  | 
              |
| 590 | 
                  +$rows = $result->fetch_hash_all;  | 
              |
| 591 | 
                  +is_deeply($rows, [], "$test : rollback");  | 
              |
| 592 | 
                  +  | 
              |
| 593 | 
                  +$dbi->begin_work;  | 
              |
| 594 | 
                  +  | 
              |
| 595 | 
                  +eval {
                 | 
              |
| 596 | 
                  +    $dbi->insert(table => 'table1', param => {key1 => 1, key2 => 2});
                 | 
              |
| 597 | 
                  +    $dbi->insert(table => 'table1', param => {key1 => 3, key2 => 4});
                 | 
              |
| 598 | 
                  +};  | 
              |
| 599 | 
                  +  | 
              |
| 600 | 
                  +$dbi->commit unless $@;  | 
              |
| 601 | 
                  +  | 
              |
| 602 | 
                  +$result = $dbi->select(table => 'table1');  | 
              |
| 603 | 
                  +$rows = $result->fetch_hash_all;  | 
              |
| 604 | 
                  +is_deeply($rows, [{key1 => 1, key2 => 2}, {key1 => 3, key2 => 4}], "$test : commit");
                 | 
              |
| 605 | 
                  +  | 
              |
| 606 | 
                  +$dbi->dbh->{AutoCommit} = 0;
                 | 
              |
| 607 | 
                  +eval{ $dbi->begin_work };
                 | 
              |
| 608 | 
                  +ok($@, "$test : exception");  | 
              |
| 609 | 
                  +$dbi->dbh->{AutoCommit} = 1;
                 | 
              |
| 610 | 
                  +  |