DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1148 lines | 29.204kb
cleanup
yuki-kimoto authored on 2009-12-22
1
package DBIx::Custom;
2

            
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
3
our $VERSION = '0.1622';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

            
5
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
6
use strict;
7
use warnings;
8

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
9
use base 'Object::Simple';
many change
yuki-kimoto authored on 2010-02-11
10

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
update document
yuki-kimoto authored on 2010-05-27
16
use Encode qw/encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
17

            
cleanup
yuki-kimoto authored on 2010-10-17
18
__PACKAGE__->attr([qw/data_source dbh default_bind_filter
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
19
                      dbi_options default_fetch_filter password user/]);
added cache_method attribute
yuki-kimoto authored on 2010-06-25
20

            
add cache attribute
yuki-kimoto authored on 2010-06-14
21
__PACKAGE__->attr(cache => 1);
added cache_method attribute
yuki-kimoto authored on 2010-06-25
22
__PACKAGE__->attr(cache_method => sub {
23
    sub {
24
        my $self = shift;
25
        
26
        $self->{_cached} ||= {};
27
        
28
        if (@_ > 1) {
29
            $self->{_cached}{$_[0]} = $_[1] 
30
        }
31
        else {
32
            return $self->{_cached}{$_[0]}
33
        }
34
    }
35
});
removed register_format()
yuki-kimoto authored on 2010-05-26
36

            
cleanup (removed undocumente...
yuki-kimoto authored on 2010-11-10
37
__PACKAGE__->attr(filters => sub {
38
    {
39
        encode_utf8 => sub { encode_utf8($_[0]) },
40
        decode_utf8 => sub { decode_utf8($_[0]) }
41
    }
42
});
added check_filter attribute
yuki-kimoto authored on 2010-08-08
43
__PACKAGE__->attr(filter_check => 1);
cleanup
yuki-kimoto authored on 2010-10-17
44
__PACKAGE__->attr(query_builder  => sub {DBIx::Custom::QueryBuilder->new});
45
__PACKAGE__->attr(result_class => 'DBIx::Custom::Result');
46

            
47
# DBI methods
48
foreach my $method (qw/begin_work commit rollback/) {
49
    my $code = sub {
50
        my $self = shift;
51
        my $ret = eval {$self->dbh->$method};
52
        croak $@ if $@;
53
        return $ret;
54
    };
55
    no strict 'refs';
56
    my $pkg = __PACKAGE__;
57
    *{"${pkg}::$method"} = $code;
58
};
59

            
added helper method
yuki-kimoto authored on 2010-10-17
60
our $AUTOLOAD;
61

            
62
sub AUTOLOAD {
63
    my $self = shift;
64

            
65
    # Method
66
    my ($package, $method) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
67

            
68
    # Helper
69
    $self->{_helpers} ||= {};
70
    croak qq/Can't locate object method "$method" via "$package"/
71
      unless my $helper = $self->{_helpers}->{$method};
72

            
73
    # Run
74
    return $self->$helper(@_);
75
}
76

            
77
sub helper {
78
    my $self = shift;
79
    
80
    # Merge
81
    my $helpers = ref $_[0] eq 'HASH' ? $_[0] : {@_};
82
    $self->{_helpers} = {%{$self->{_helpers} || {}}, %$helpers};
83
    
84
    return $self;
85
}
86

            
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
87
#sub new {
88
#    my $self = shift->SUPER::new(@_);
89
#    
90
#    # Check attribute names
91
#    my @attrs = keys %$self;
92
#    foreach my $attr (@attrs) {
93
#        croak qq{"$attr" is invalid attribute name"}
94
#          unless $self->can($attr);
95
#    }
96
#    
97
#    return $self;
98
#}
99

            
packaging one directory
yuki-kimoto authored on 2009-11-16
100
sub connect {
removed register_format()
yuki-kimoto authored on 2010-05-26
101
    my $proto = shift;
102
    
103
    # Create
104
    my $self = ref $proto ? $proto : $proto->new(@_);
update document
yuki-kimoto authored on 2010-01-30
105
    
106
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
107
    my $data_source = $self->data_source;
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
108
    
109
    croak qq{"data_source" must be specfied to connect method"}
110
      unless $data_source;
111
    
packaging one directory
yuki-kimoto authored on 2009-11-16
112
    my $user        = $self->user;
113
    my $password    = $self->password;
114
    
update document
yuki-kimoto authored on 2010-01-30
115
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
116
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
117
        $data_source,
118
        $user,
119
        $password,
120
        {
121
            RaiseError => 1,
122
            PrintError => 0,
123
            AutoCommit => 1,
124
        }
125
    )};
126
    
update document
yuki-kimoto authored on 2010-01-30
127
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
128
    croak $@ if $@;
129
    
update document
yuki-kimoto authored on 2010-01-30
130
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
131
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
132
    
packaging one directory
yuki-kimoto authored on 2009-11-16
133
    return $self;
134
}
135

            
cleanup
yuki-kimoto authored on 2010-10-17
136
sub create_query {
137
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
138
    
cleanup
yuki-kimoto authored on 2010-10-17
139
    # Cache
140
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
141
    
cleanup
yuki-kimoto authored on 2010-10-17
142
    # Create query
143
    my $query;
144
    if ($cache) {
145
        
146
        # Get query
147
        my $q = $self->cache_method->($self, $source);
148
        
149
        # Create query
150
        $query = DBIx::Custom::Query->new($q) if $q;
151
    }
152
    
153
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
154

            
cleanup
yuki-kimoto authored on 2010-10-17
155
        # Create SQL object
156
        my $builder = $self->query_builder;
157
        
158
        # Create query
159
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
160

            
cleanup
yuki-kimoto authored on 2010-10-17
161
        # Cache query
162
        $self->cache_method->($self, $source,
163
                             {sql     => $query->sql, 
164
                              columns => $query->columns})
165
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
166
    }
167
    
cleanup
yuki-kimoto authored on 2010-10-17
168
    # Prepare statement handle
169
    my $sth;
170
    eval { $sth = $self->dbh->prepare($query->{sql})};
171
    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
172
    
cleanup
yuki-kimoto authored on 2010-10-17
173
    # Set statement handle
174
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
175
    
cleanup
yuki-kimoto authored on 2010-10-17
176
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
177
}
178

            
cleanup
yuki-kimoto authored on 2010-10-17
179
our %VALID_DELETE_ARGS
180
  = map { $_ => 1 } qw/table where append filter allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
181

            
cleanup
yuki-kimoto authored on 2010-10-17
182
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
183
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
184
    
185
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
186
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
187
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
188
          unless $VALID_DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
189
    }
190
    
191
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
192
    my $table            = $args{table} || '';
193
    my $where            = $args{where} || {};
cleanup
yuki-kimoto authored on 2010-10-17
194
    my $append = $args{append};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
195
    my $filter           = $args{filter};
cleanup
yuki-kimoto authored on 2010-10-17
196
    my $allow_delete_all = $args{allow_delete_all};
packaging one directory
yuki-kimoto authored on 2009-11-16
197
    
198
    # Where keys
removed register_format()
yuki-kimoto authored on 2010-05-26
199
    my @where_keys = keys %$where;
packaging one directory
yuki-kimoto authored on 2009-11-16
200
    
201
    # Not exists where keys
add tests
yuki-kimoto authored on 2010-08-10
202
    croak qq{"where" argument must be specified and } .
203
          qq{contains the pairs of column name and value}
cleanup
yuki-kimoto authored on 2010-10-17
204
      if !@where_keys && !$allow_delete_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
205
    
206
    # Where clause
207
    my $where_clause = '';
208
    if (@where_keys) {
209
        $where_clause = 'where ';
add tests
yuki-kimoto authored on 2010-08-10
210
        $where_clause .= "{= $_} and " for @where_keys;
packaging one directory
yuki-kimoto authored on 2009-11-16
211
        $where_clause =~ s/ and $//;
212
    }
213
    
add tests
yuki-kimoto authored on 2010-08-10
214
    # Source of SQL
cleanup
yuki-kimoto authored on 2010-10-17
215
    my $source = "delete from $table $where_clause";
add tests
yuki-kimoto authored on 2010-08-10
216
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
217
    
218
    # Execute query
cleanup
yuki-kimoto authored on 2010-10-17
219
    my $ret_val = $self->execute($source, param  => $where, 
add tests
yuki-kimoto authored on 2010-08-10
220
                                 filter => $filter);
packaging one directory
yuki-kimoto authored on 2009-11-16
221
    
222
    return $ret_val;
223
}
224

            
cleanup
yuki-kimoto authored on 2010-10-17
225
sub delete_all { shift->delete(allow_delete_all => 1, @_) }
packaging one directory
yuki-kimoto authored on 2009-11-16
226

            
added helper method
yuki-kimoto authored on 2010-10-17
227
sub DESTROY { }
228

            
cleanup
yuki-kimoto authored on 2010-10-17
229
our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter/;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
230

            
cleanup
yuki-kimoto authored on 2010-10-17
231
sub execute{
232
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
233
    
234
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
235
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
236
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
237
          unless $VALID_EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
238
    }
239
    
cleanup
yuki-kimoto authored on 2010-10-17
240
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
241
    
cleanup
yuki-kimoto authored on 2010-10-17
242
    # First argument is the soruce of SQL
243
    $query = $self->create_query($query)
244
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
245
    
cleanup
yuki-kimoto authored on 2010-10-17
246
    my $filter = $args{filter} || $query->filter || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
247
    
cleanup
yuki-kimoto authored on 2010-10-17
248
    # Create bind value
249
    my $bind_values = $self->_build_bind_values($query, $params, $filter);
250
    
251
    # Execute
252
    my $sth      = $query->sth;
253
    my $affected;
254
    eval {$affected = $sth->execute(@$bind_values)};
255
    $self->_croak($@) if $@;
256
    
257
    # Return resultset if select statement is executed
258
    if ($sth->{NUM_OF_FIELDS}) {
259
        
260
        # Create result
261
        my $result = $self->result_class->new(
262
            sth            => $sth,
263
            default_filter => $self->default_fetch_filter,
264
            filters        => $self->filters,
265
            filter_check   => $self->filter_check
266
        );
267

            
268
        return $result;
269
    }
270
    return $affected;
271
}
272

            
added experimental expand me...
yuki-kimoto authored on 2010-10-20
273
sub expand {
274
    my $self = shift;
275
    my $source = ref $_[0] eq 'HASH' ? $_[0] : {@_};
276
    my $table = (keys %$source)[0];
277
    my $param = $source->{$table};
278
    
279
    # Expand table name
280
    my $expand = {};
281
    foreach my $column (keys %$param) {
282
        $expand->{"$table.$column"} = $param->{$column};
283
    }
284
    
285
    return %$expand;
286
}
287

            
cleanup
yuki-kimoto authored on 2010-10-17
288
our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append filter/;
289

            
290
sub insert {
291
    my ($self, %args) = @_;
292

            
293
    # Check arguments
294
    foreach my $name (keys %args) {
295
        croak qq{"$name" is invalid argument}
296
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
297
    }
298
    
cleanup
yuki-kimoto authored on 2010-10-17
299
    # Arguments
300
    my $table  = $args{table} || '';
301
    my $param  = $args{param} || {};
302
    my $append = $args{append} || '';
303
    my $filter = $args{filter};
304
    
305
    # Insert keys
306
    my @insert_keys = keys %$param;
307
    
308
    # Templte for insert
309
    my $source = "insert into $table {insert_param "
310
               . join(' ', @insert_keys) . '}';
add tests
yuki-kimoto authored on 2010-08-10
311
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
312
    
313
    # Execute query
cleanup
yuki-kimoto authored on 2010-10-17
314
    my $ret_val = $self->execute($source, param  => $param, 
315
                                          filter => $filter);
packaging one directory
yuki-kimoto authored on 2009-11-16
316
    
317
    return $ret_val;
318
}
319

            
cleanup
yuki-kimoto authored on 2010-10-17
320
sub register_filter {
321
    my $invocant = shift;
322
    
323
    # Register filter
324
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
325
    $invocant->filters({%{$invocant->filters}, %$filters});
326
    
327
    return $invocant;
328
}
packaging one directory
yuki-kimoto authored on 2009-11-16
329

            
refactoring select
yuki-kimoto authored on 2010-04-28
330
our %VALID_SELECT_ARGS
added commit method
yuki-kimoto authored on 2010-05-27
331
  = map { $_ => 1 } qw/table column where append relation filter param/;
refactoring select
yuki-kimoto authored on 2010-04-28
332

            
packaging one directory
yuki-kimoto authored on 2009-11-16
333
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
334
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
335
    
refactoring select
yuki-kimoto authored on 2010-04-28
336
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
337
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
338
        croak qq{"$name" is invalid argument}
refactoring select
yuki-kimoto authored on 2010-04-28
339
          unless $VALID_SELECT_ARGS{$name};
340
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
341
    
refactoring select
yuki-kimoto authored on 2010-04-28
342
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
343
    my $tables = $args{table} || [];
removed register_format()
yuki-kimoto authored on 2010-05-26
344
    $tables = [$tables] unless ref $tables eq 'ARRAY';
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
345
    my $columns  = $args{column} || [];
update document
yuki-kimoto authored on 2010-08-07
346
    my $where    = $args{where};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
347
    my $relation = $args{relation};
348
    my $append   = $args{append};
349
    my $filter   = $args{filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
350
    
add tests
yuki-kimoto authored on 2010-08-10
351
    # Source of SQL
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
352
    my $source = 'select ';
packaging one directory
yuki-kimoto authored on 2009-11-16
353
    
added commit method
yuki-kimoto authored on 2010-05-27
354
    # Column clause
packaging one directory
yuki-kimoto authored on 2009-11-16
355
    if (@$columns) {
356
        foreach my $column (@$columns) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
357
            $source .= "$column, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
358
        }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
359
        $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
360
    }
361
    else {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
362
        $source .= '* ';
packaging one directory
yuki-kimoto authored on 2009-11-16
363
    }
364
    
added commit method
yuki-kimoto authored on 2010-05-27
365
    # Table
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
366
    $source .= 'from ';
packaging one directory
yuki-kimoto authored on 2009-11-16
367
    foreach my $table (@$tables) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
368
        $source .= "$table, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
369
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
370
    $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
371
    
added commit method
yuki-kimoto authored on 2010-05-27
372
    # Where clause
update document
yuki-kimoto authored on 2010-08-07
373
    my $param;
374
    if (ref $where eq 'HASH') {
375
        $param = $where;
376
        $source .= 'where (';
377
        foreach my $where_key (keys %$where) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
378
            $source .= "{= $where_key} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
379
        }
update document
yuki-kimoto authored on 2010-08-07
380
        $source =~ s/ and $//;
381
        $source .= ') ';
382
    }
383
    elsif (ref $where eq 'ARRAY') {
384
        my$where_str = $where->[0] || '';
385
        $param = $where->[1];
386
        
387
        $source .= "where ($where_str) ";
packaging one directory
yuki-kimoto authored on 2009-11-16
388
    }
389
    
added commit method
yuki-kimoto authored on 2010-05-27
390
    # Relation
391
    if ($relation) {
update document
yuki-kimoto authored on 2010-08-07
392
        $source .= $where ? "and " : "where ";
added commit method
yuki-kimoto authored on 2010-05-27
393
        foreach my $rkey (keys %$relation) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
394
            $source .= "$rkey = " . $relation->{$rkey} . " and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
395
        }
396
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
397
    $source =~ s/ and $//;
added commit method
yuki-kimoto authored on 2010-05-27
398
    
399
    # Append some statement
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
400
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
401
    
402
    # Execute query
update document
yuki-kimoto authored on 2010-08-07
403
    my $result = $self->execute($source, param  => $param, 
404
                                         filter => $filter);
packaging one directory
yuki-kimoto authored on 2009-11-16
405
    
406
    return $result;
407
}
408

            
cleanup
yuki-kimoto authored on 2010-10-17
409
our %VALID_UPDATE_ARGS
410
  = map { $_ => 1 } qw/table param where append filter allow_update_all/;
411

            
412
sub update {
413
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
414
    
cleanup
yuki-kimoto authored on 2010-10-17
415
    # Check arguments
416
    foreach my $name (keys %args) {
417
        croak qq{"$name" is invalid argument}
418
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
419
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
420
    
cleanup
yuki-kimoto authored on 2010-10-17
421
    # Arguments
422
    my $table            = $args{table} || '';
423
    my $param            = $args{param} || {};
424
    my $where            = $args{where} || {};
425
    my $append = $args{append} || '';
426
    my $filter           = $args{filter};
427
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
428
    
cleanup
yuki-kimoto authored on 2010-10-17
429
    # Update keys
430
    my @update_keys = keys %$param;
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
431
    
cleanup
yuki-kimoto authored on 2010-10-17
432
    # Where keys
433
    my @where_keys = keys %$where;
removed reconnect method
yuki-kimoto authored on 2010-05-28
434
    
cleanup
yuki-kimoto authored on 2010-10-17
435
    # Not exists where keys
436
    croak qq{"where" argument must be specified and } .
437
          qq{contains the pairs of column name and value}
438
      if !@where_keys && !$allow_update_all;
removed experimental registe...
yuki-kimoto authored on 2010-08-24
439
    
cleanup
yuki-kimoto authored on 2010-10-17
440
    # Update clause
441
    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
removed experimental registe...
yuki-kimoto authored on 2010-08-24
442
    
cleanup
yuki-kimoto authored on 2010-10-17
443
    # Where clause
444
    my $where_clause = '';
445
    my $new_where = {};
removed reconnect method
yuki-kimoto authored on 2010-05-28
446
    
cleanup
yuki-kimoto authored on 2010-10-17
447
    if (@where_keys) {
448
        $where_clause = 'where ';
449
        $where_clause .= "{= $_} and " for @where_keys;
450
        $where_clause =~ s/ and $//;
removed reconnect method
yuki-kimoto authored on 2010-05-28
451
    }
452
    
cleanup
yuki-kimoto authored on 2010-10-17
453
    # Source of SQL
454
    my $source = "update $table $update_clause $where_clause";
455
    $source .= " $append" if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
456
    
cleanup
yuki-kimoto authored on 2010-10-17
457
    # Rearrange parameters
458
    foreach my $wkey (@where_keys) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
459
        
cleanup
yuki-kimoto authored on 2010-10-17
460
        if (exists $param->{$wkey}) {
461
            $param->{$wkey} = [$param->{$wkey}]
462
              unless ref $param->{$wkey} eq 'ARRAY';
463
            
464
            push @{$param->{$wkey}}, $where->{$wkey};
465
        }
466
        else {
467
            $param->{$wkey} = $where->{$wkey};
468
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
469
    }
cleanup
yuki-kimoto authored on 2010-10-17
470
    
471
    # Execute query
472
    my $ret_val = $self->execute($source, param  => $param, 
473
                                 filter => $filter);
474
    
475
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
476
}
477

            
cleanup
yuki-kimoto authored on 2010-10-17
478
sub update_all { shift->update(allow_update_all => 1, @_) };
479

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
480
sub _build_bind_values {
481
    my ($self, $query, $params, $filter) = @_;
482
    
483
    # binding values
484
    my @bind_values;
add tests
yuki-kimoto authored on 2010-08-08
485

            
486
    # Filter
487
    $filter ||= {};
488
    
489
    # Parameter
490
    $params ||= {};
491
    
492
    # Check filter
493
    $self->_check_filter($self->filters, $filter,
494
                         $self->default_bind_filter, $params)
495
      if $self->filter_check;
removed reconnect method
yuki-kimoto authored on 2010-05-28
496
    
497
    # Build bind values
498
    my $count = {};
499
    foreach my $column (@{$query->columns}) {
500
        
501
        # Value
502
        my $value = ref $params->{$column} eq 'ARRAY'
503
                  ? $params->{$column}->[$count->{$column} || 0]
504
                  : $params->{$column};
505
        
add tests
yuki-kimoto authored on 2010-08-10
506
        # Filtering
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
507
        my $fname = $filter->{$column} || $self->default_bind_filter || '';
add tests
yuki-kimoto authored on 2010-08-10
508
        my $filter_func = $fname ? $self->filters->{$fname} : undef;
removed reconnect method
yuki-kimoto authored on 2010-05-28
509
        push @bind_values, $filter_func
510
                         ? $filter_func->($value)
511
                         : $value;
512
        
513
        # Count up 
514
        $count->{$column}++;
515
    }
516
    
517
    return \@bind_values;
518
}
519

            
add tests
yuki-kimoto authored on 2010-08-08
520
sub _check_filter {
521
    my ($self, $filters, $filter, $default_filter, $params) = @_;
522
    
523
    # Filter name not exists
524
    foreach my $fname (values %$filter) {
525
        croak qq{Bind filter "$fname" is not registered}
526
          unless exists $filters->{$fname};
527
    }
528
    
529
    # Default filter name not exists
530
    croak qq{Default bind filter "$default_filter" is not registered}
531
      if $default_filter && ! exists $filters->{$default_filter};
532
    
533
    # Column name not exists
534
    foreach my $column (keys %$filter) {
535
        
536
        croak qq{Column name "$column" in bind filter is not found in paramters}
537
          unless exists $params->{$column};
538
    }
539
}
540

            
cleanup
yuki-kimoto authored on 2010-10-17
541
sub _croak {
542
    my ($self, $error, $append) = @_;
543
    $append ||= "";
544
    
545
    # Verbose
546
    if ($Carp::Verbose) { croak $error }
547
    
548
    # Not verbose
549
    else {
550
        
551
        # Remove line and module infromation
552
        my $at_pos = rindex($error, ' at ');
553
        $error = substr($error, 0, $at_pos);
554
        $error =~ s/\s+$//;
555
        
556
        croak "$error$append";
557
    }
558
}
559

            
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
560
1;
561

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
562
=head1 NAME
563

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
564
DBIx::Custom - DBI interface, having hash parameter binding and filtering system
removed reconnect method
yuki-kimoto authored on 2010-05-28
565

            
566
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
567

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
568
Connect to the database.
569
    
570
    use DBIx::Custom;
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
571
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
removed reconnect method
yuki-kimoto authored on 2010-05-28
572
                                    user => 'ken', password => '!LFKD%$&');
cleanup
yuki-kimoto authored on 2010-08-05
573

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
574
Insert, update, and delete
cleanup
yuki-kimoto authored on 2010-08-05
575

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
576
    # Insert 
577
    $dbi->insert(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
578
                 param  => {title => 'Perl', author => 'Ken'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
579
                 filter => {title => 'encode_utf8'});
580
    
581
    # Update 
582
    $dbi->update(table  => 'books', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
583
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
584
                 where  => {id => 5},
585
                 filter => {title => 'encode_utf8'});
586
    
587
    # Update all
588
    $dbi->update_all(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
589
                     param  => {title => 'Perl'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
590
                     filter => {title => 'encode_utf8'});
591
    
592
    # Delete
593
    $dbi->delete(table  => 'books',
594
                 where  => {author => 'Ken'},
595
                 filter => {title => 'encode_utf8'});
596
    
597
    # Delete all
598
    $dbi->delete_all(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
599

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
600
Select
cleanup
yuki-kimoto authored on 2010-08-05
601

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
602
    # Select
603
    my $result = $dbi->select(table => 'books');
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
604
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
605
    # Select, more complex
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
606
    my $result = $dbi->select(
update document
yuki-kimoto authored on 2010-05-27
607
        table  => 'books',
608
        column => [qw/author title/],
609
        where  => {author => 'Ken'},
updated document
yuki-kimoto authored on 2010-08-08
610
        append => 'order by id limit 5',
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
611
        filter => {title => 'encode_utf8'}
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
612
    );
added commit method
yuki-kimoto authored on 2010-05-27
613
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
614
    # Select, join table
added commit method
yuki-kimoto authored on 2010-05-27
615
    my $result = $dbi->select(
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
616
        table    => ['books', 'rental'],
617
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
618
        relation => {'books.id' => 'rental.book_id'}
619
    );
updated document
yuki-kimoto authored on 2010-08-08
620
    
621
    # Select, more flexible where
622
    my $result = $dbi->select(
623
        table  => 'books',
624
        where  => ['{= author} and {like title}', 
625
                   {author => 'Ken', title => '%Perl%'}]
626
    );
cleanup
yuki-kimoto authored on 2010-08-05
627

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
628
Execute SQL
cleanup
yuki-kimoto authored on 2010-08-05
629

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
630
    # Execute SQL
removed register_format()
yuki-kimoto authored on 2010-05-26
631
    $dbi->execute("select title from books");
632
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
633
    # Execute SQL with hash binding and filtering
updated document
yuki-kimoto authored on 2010-08-08
634
    $dbi->execute("select id from books where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
635
                  param  => {author => 'ken', title => '%Perl%'},
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
636
                  filter => {title => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
637

            
638
    # Create query and execute it
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
639
    my $query = $dbi->create_query(
updated document
yuki-kimoto authored on 2010-08-08
640
        "select id from books where {= author} and {like title}"
removed reconnect method
yuki-kimoto authored on 2010-05-28
641
    );
updated document
yuki-kimoto authored on 2010-08-08
642
    $dbi->execute($query, param => {author => 'Ken', title => '%Perl%'})
cleanup
yuki-kimoto authored on 2010-08-05
643

            
updated document
yuki-kimoto authored on 2010-08-08
644
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
645

            
removed register_format()
yuki-kimoto authored on 2010-05-26
646
    # Default filter
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
647
    $dbi->default_bind_filter('encode_utf8');
removed register_format()
yuki-kimoto authored on 2010-05-26
648
    $dbi->default_fetch_filter('decode_utf8');
cleanup
yuki-kimoto authored on 2010-08-05
649

            
650
    # Get DBI object
651
    my $dbh = $dbi->dbh;
652

            
653
Fetch row.
654

            
removed register_format()
yuki-kimoto authored on 2010-05-26
655
    # Fetch
656
    while (my $row = $result->fetch) {
657
        # ...
658
    }
659
    
660
    # Fetch hash
661
    while (my $row = $result->fetch_hash) {
662
        
663
    }
664
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
665
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
666

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
667
L<DBIx::Custom> is one of L<DBI> interface modules,
668
such as L<DBIx::Class>, L<DBIx::Simple>.
removed reconnect method
yuki-kimoto authored on 2010-05-28
669

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
670
This module is not O/R mapper. O/R mapper is useful,
671
but you must learn many syntax of the O/R mapper,
updated document
yuki-kimoto authored on 2010-08-08
672
which is almost another language.
673
Created SQL statement is offten not effcient and damage SQL performance.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
674
so you have to execute raw SQL in the end.
removed reconnect method
yuki-kimoto authored on 2010-05-28
675

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
676
L<DBIx::Custom> is middle area between L<DBI> and O/R mapper.
updated document
yuki-kimoto authored on 2010-08-08
677
L<DBIx::Custom> provide flexible hash parameter binding and filtering system,
added experimental expand me...
yuki-kimoto authored on 2010-10-20
678
and suger methods, such as C<insert()>, C<update()>, C<delete()>, C<select()>
updated document
yuki-kimoto authored on 2010-08-08
679
to execute SQL easily.
removed reconnect method
yuki-kimoto authored on 2010-05-28
680

            
updated document
yuki-kimoto authored on 2010-08-08
681
L<DBIx::Custom> respects SQL. SQL is very complex and not beautiful,
682
but de-facto standard,
683
so all people learing database know it.
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
684
If you already know SQL,
685
you learn a little thing to use L<DBIx::Custom>.
removed reconnect method
yuki-kimoto authored on 2010-05-28
686

            
added DBIx::Custom::Guides
yuki-kimoto authored on 2010-10-17
687
See L<DBIx::Custom::Guides> for more details.
updated document
yuki-kimoto authored on 2010-08-08
688

            
update document
yuki-kimoto authored on 2010-01-30
689
=head1 ATTRIBUTES
packaging one directory
yuki-kimoto authored on 2009-11-16
690

            
cleanup
yuki-kimoto authored on 2010-10-17
691
=head2 C<cache>
packaging one directory
yuki-kimoto authored on 2009-11-16
692

            
cleanup
yuki-kimoto authored on 2010-10-17
693
    my $cache = $dbi->cache;
694
    $dbi      = $dbi->cache(1);
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
695

            
cleanup
yuki-kimoto authored on 2010-10-17
696
Enable parsed L<DBIx::Custom::Query> object caching.
697
Default to 1.
packaging one directory
yuki-kimoto authored on 2009-11-16
698

            
cleanup
yuki-kimoto authored on 2010-10-17
699
=head2 C<cache_method>
packaging one directory
yuki-kimoto authored on 2009-11-16
700

            
cleanup
yuki-kimoto authored on 2010-10-17
701
    $dbi          = $dbi->cache_method(\&cache_method);
702
    $cache_method = $dbi->cache_method
703

            
704
Method to set and get caches.
705

            
706
B<Example:>
707

            
708
    $dbi->cache_method(
709
        sub {
710
            my $self = shift;
711
            
712
            $self->{_cached} ||= {};
713
            
714
            if (@_ > 1) {
715
                $self->{_cached}{$_[0]} = $_[1] 
716
            }
717
            else {
718
                return $self->{_cached}{$_[0]}
719
            }
720
        }
721
    );
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
722

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
723
=head2 C<data_source>
packaging one directory
yuki-kimoto authored on 2009-11-16
724

            
cleanup
yuki-kimoto authored on 2010-08-03
725
    my $data_source = $dbi->data_source;
cleanup
yuki-kimoto authored on 2010-08-05
726
    $dbi            = $dbi->data_source("DBI:mysql:database=dbname");
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
727

            
cleanup
yuki-kimoto authored on 2010-08-05
728
Data source.
729
C<connect()> method use this value to connect the database.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
730

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
731
=head2 C<dbh>
packaging one directory
yuki-kimoto authored on 2009-11-16
732

            
cleanup
yuki-kimoto authored on 2010-08-03
733
    my $dbh = $dbi->dbh;
734
    $dbi    = $dbi->dbh($dbh);
packaging one directory
yuki-kimoto authored on 2009-11-16
735

            
cleanup
yuki-kimoto authored on 2010-08-05
736
L<DBI> object. You can call all methods of L<DBI>.
packaging one directory
yuki-kimoto authored on 2009-11-16
737

            
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
738
=head2 C<default_bind_filter>
packaging one directory
yuki-kimoto authored on 2009-11-16
739

            
cleanup
yuki-kimoto authored on 2010-08-03
740
    my $default_bind_filter = $dbi->default_bind_filter
741
    $dbi                    = $dbi->default_bind_filter('encode_utf8');
packaging one directory
yuki-kimoto authored on 2009-11-16
742

            
cleanup
yuki-kimoto authored on 2010-08-05
743
Default filter when parameter binding is executed.
packaging one directory
yuki-kimoto authored on 2009-11-16
744

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
745
=head2 C<default_fetch_filter>
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
746

            
cleanup
yuki-kimoto authored on 2010-08-03
747
    my $default_fetch_filter = $dbi->default_fetch_filter;
748
    $dbi                     = $dbi->default_fetch_filter('decode_utf8');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
749

            
cleanup
yuki-kimoto authored on 2010-08-05
750
Default filter when row is fetched.
packaging one directory
yuki-kimoto authored on 2009-11-16
751

            
cleanup
yuki-kimoto authored on 2010-10-17
752
=head2 C<filters>
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
753

            
cleanup
yuki-kimoto authored on 2010-10-17
754
    my $filters = $dbi->filters;
755
    $dbi        = $dbi->filters(\%filters);
packaging one directory
yuki-kimoto authored on 2009-11-16
756

            
cleanup
yuki-kimoto authored on 2010-10-17
757
Filter functions.
758
"encode_utf8" and "decode_utf8" is registered by default.
759

            
760
=head2 C<filter_check>
761

            
762
    my $filter_check = $dbi->filter_check;
763
    $dbi             = $dbi->filter_check(0);
764

            
765
Enable filter check. 
766
Default to 1.
767
This check maybe damege performance.
768
If you require performance, set C<filter_check> attribute to 0.
769

            
770
=head2 C<password>
771

            
772
    my $password = $dbi->password;
773
    $dbi         = $dbi->password('lkj&le`@s');
774

            
775
Password.
776
C<connect()> method use this value to connect the database.
update document
yuki-kimoto authored on 2010-01-30
777

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
778
=head2 C<query_builder>
added commit method
yuki-kimoto authored on 2010-05-27
779

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
780
    my $sql_class = $dbi->query_builder;
781
    $dbi          = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
added commit method
yuki-kimoto authored on 2010-05-27
782

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
783
SQL builder. C<query_builder()> must be 
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
784
the instance of L<DBIx::Custom::QueryBuilder> subclass.
785
Default to L<DBIx::Custom::QueryBuilder> object.
cleanup
yuki-kimoto authored on 2010-08-05
786

            
cleanup
yuki-kimoto authored on 2010-10-17
787
=head2 C<result_class>
cleanup
yuki-kimoto authored on 2010-08-05
788

            
cleanup
yuki-kimoto authored on 2010-10-17
789
    my $result_class = $dbi->result_class;
790
    $dbi             = $dbi->result_class('DBIx::Custom::Result');
cleanup
yuki-kimoto authored on 2010-08-05
791

            
cleanup
yuki-kimoto authored on 2010-10-17
792
Result class for select statement.
793
Default to L<DBIx::Custom::Result>.
cleanup
yuki-kimoto authored on 2010-08-05
794

            
cleanup
yuki-kimoto authored on 2010-10-17
795
=head2 C<user>
cleanup
yuki-kimoto authored on 2010-08-05
796

            
cleanup
yuki-kimoto authored on 2010-10-17
797
    my $user = $dbi->user;
798
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
799

            
cleanup
yuki-kimoto authored on 2010-10-17
800
User name.
801
C<connect()> method use this value to connect the database.
802
    
803
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
804

            
cleanup
yuki-kimoto authored on 2010-10-17
805
L<DBIx::Custom> inherits all methods from L<Object::Simple>
806
and implements the following new ones.
added check_filter attribute
yuki-kimoto authored on 2010-08-08
807

            
cleanup
yuki-kimoto authored on 2010-10-17
808
=head2 begin_work
added check_filter attribute
yuki-kimoto authored on 2010-08-08
809

            
cleanup
yuki-kimoto authored on 2010-10-17
810
    $dbi->begin_work;
added check_filter attribute
yuki-kimoto authored on 2010-08-08
811

            
cleanup
yuki-kimoto authored on 2010-10-17
812
Start transaction.
813
This is same as L<DBI>'s C<begin_work>.
added commit method
yuki-kimoto authored on 2010-05-27
814

            
cleanup
yuki-kimoto authored on 2010-08-05
815
L<DBIx::Custom> inherits all methods from L<Object::Simple>
816
and implements the following new ones.
added commit method
yuki-kimoto authored on 2010-05-27
817

            
cleanup
yuki-kimoto authored on 2010-10-17
818
=head2 commit
819

            
820
    $dbi->commit;
821

            
822
Commit transaction.
823
This is same as L<DBI>'s C<commit>.
824

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
825
=head2 C<connect>
packaging one directory
yuki-kimoto authored on 2009-11-16
826

            
cleanup
yuki-kimoto authored on 2010-08-05
827
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
update document
yuki-kimoto authored on 2010-05-27
828
                                    user => 'ken', password => '!LFKD%$&');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
829

            
cleanup
yuki-kimoto authored on 2010-08-05
830
Create a new L<DBIx::Custom> object and connect to the database.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
831
L<DBIx::Custom> is a wrapper of L<DBI>.
cleanup
yuki-kimoto authored on 2010-08-09
832
C<AutoCommit> and C<RaiseError> options are true, 
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
833
and C<PrintError> option is false by default. 
packaging one directory
yuki-kimoto authored on 2009-11-16
834

            
cleanup
yuki-kimoto authored on 2010-10-17
835
=head2 C<create_query>
836
    
837
    my $query = $dbi->create_query(
838
        "select * from books where {= author} and {like title};"
839
    );
update document
yuki-kimoto authored on 2009-11-19
840

            
cleanup
yuki-kimoto authored on 2010-10-17
841
Create the instance of L<DBIx::Custom::Query> from the source of SQL.
842
If you want to get high performance,
843
use C<create_query()> method and execute it by C<execute()> method
844
instead of suger methods.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
845

            
cleanup
yuki-kimoto authored on 2010-10-17
846
    $dbi->execute($query, {author => 'Ken', title => '%Perl%'});
version 0.0901
yuki-kimoto authored on 2009-12-17
847

            
cleanup
yuki-kimoto authored on 2010-10-17
848
=head2 C<execute>
packaging one directory
yuki-kimoto authored on 2009-11-16
849

            
cleanup
yuki-kimoto authored on 2010-10-17
850
    my $result = $dbi->execute($query,  param => $params, filter => \%filter);
851
    my $result = $dbi->execute($source, param => $params, filter => \%filter);
update document
yuki-kimoto authored on 2009-11-19
852

            
cleanup
yuki-kimoto authored on 2010-10-17
853
Execute query or the source of SQL.
854
Query is L<DBIx::Custom::Query> object.
855
Return value is L<DBIx::Custom::Result> if select statement is executed,
856
or the count of affected rows if insert, update, delete statement is executed.
version 0.0901
yuki-kimoto authored on 2009-12-17
857

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
858
B<Example:>
update document
yuki-kimoto authored on 2009-11-19
859

            
cleanup
yuki-kimoto authored on 2010-10-17
860
    my $result = $dbi->execute(
861
        "select * from books where {= author} and {like title}", 
862
        param => {author => 'Ken', title => '%Perl%'}
863
    );
864
    
865
    while (my $row = $result->fetch) {
866
        my $author = $row->[0];
867
        my $title  = $row->[1];
868
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
869

            
added experimental expand me...
yuki-kimoto authored on 2010-10-20
870
=head2 C<(experimental) expand>
871

            
872
    my %expand = $dbi->expand($source);
873

            
874
The following hash
875

            
876
    {books => {title => 'Perl', author => 'Ken'}}
877

            
878
is expanded to
879

            
880
    ('books.title' => 'Perl', 'books.author' => 'Ken')
881

            
882
This is used in C<select()>
883

            
884

            
885
    
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
886
=head2 C<delete>
packaging one directory
yuki-kimoto authored on 2009-11-16
887

            
cleanup
yuki-kimoto authored on 2010-08-05
888
    $dbi->delete(table  => $table,
889
                 where  => \%where,
890
                 append => $append,
891
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
892

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
893
Execute delete statement.
894
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
895
C<table> is a table name.
896
C<where> is where clause. this must be hash reference.
897
C<append> is a string added at the end of the SQL statement.
898
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
899
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
900

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
901
B<Example:>
packaging one directory
yuki-kimoto authored on 2009-11-16
902

            
removed register_format()
yuki-kimoto authored on 2010-05-26
903
    $dbi->delete(table  => 'books',
904
                 where  => {id => 5},
905
                 append => 'some statement',
removed reconnect method
yuki-kimoto authored on 2010-05-28
906
                 filter => {id => 'encode_utf8'});
version 0.0901
yuki-kimoto authored on 2009-12-17
907

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
908
=head2 C<delete_all>
packaging one directory
yuki-kimoto authored on 2009-11-16
909

            
cleanup
yuki-kimoto authored on 2010-08-05
910
    $dbi->delete_all(table => $table);
packaging one directory
yuki-kimoto authored on 2009-11-16
911

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
912
Execute delete statement to delete all rows.
913
Arguments is same as C<delete> method,
914
except that C<delete_all> don't have C<where> argument.
cleanup
yuki-kimoto authored on 2010-08-09
915
Return value of C<delete_all()> is the count of affected rows.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
916

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
917
B<Example:>
removed register_format()
yuki-kimoto authored on 2010-05-26
918
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
919
    $dbi->delete_all(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
920

            
added helper method
yuki-kimoto authored on 2010-10-17
921
=head2 C<(experimental) helper>
922

            
923
    $dbi->helper(
924
        update_or_insert => sub {
925
            my $self = shift;
926
            # do something
927
        },
928
        find_or_create   => sub {
929
            my $self = shift;
930
            # do something
931
        }
932
    );
933

            
934
Register helper methods. These method is called from L<DBIx::Custom> object directory.
935

            
936
    $dbi->update_or_insert;
937
    $dbi->find_or_create;
938

            
cleanup
yuki-kimoto authored on 2010-10-17
939
=head2 C<insert>
940

            
941
    $dbi->insert(table  => $table, 
942
                 param  => \%param,
943
                 append => $append,
944
                 filter => \%filter);
945

            
946
Execute insert statement.
947
C<insert> method have C<table>, C<param>, C<append>
948
and C<filter> arguments.
949
C<table> is a table name.
950
C<param> is the pairs of column name value. this must be hash reference.
951
C<append> is a string added at the end of the SQL statement.
952
C<filter> is filters when parameter binding is executed.
953
This is overwrites C<default_bind_filter>.
954
Return value of C<insert()> is the count of affected rows.
955

            
956
B<Example:>
957

            
958
    $dbi->insert(table  => 'books', 
959
                 param  => {title => 'Perl', author => 'Taro'},
960
                 append => "some statement",
961
                 filter => {title => 'encode_utf8'})
962

            
963
=head2 C<register_filter>
964

            
965
    $dbi->register_filter(%filters);
966
    $dbi->register_filter(\%filters);
967
    
968
Register filter. Registered filters is available in the following attributes
969
or arguments.
970

            
971
=over 4
972

            
973
=item *
974

            
975
C<default_bind_filter>, C<default_fetch_filter>
976

            
977
=item *
978

            
979
C<filter> argument of C<insert()>, C<update()>,
980
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
981
methods
982

            
983
=item *
984

            
985
C<execute()> method
986

            
987
=item *
988

            
989
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
990

            
991
=item *
992

            
993
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
994

            
995
=back
996

            
997
B<Example:>
998

            
999
    $dbi->register_filter(
1000
        encode_utf8 => sub {
1001
            my $value = shift;
1002
            
1003
            require Encode;
1004
            
1005
            return Encode::encode('UTF-8', $value);
1006
        },
1007
        decode_utf8 => sub {
1008
            my $value = shift;
1009
            
1010
            require Encode;
1011
            
1012
            return Encode::decode('UTF-8', $value)
1013
        }
1014
    );
1015

            
1016
=head2 rollback
1017

            
1018
    $dbi->rollback;
1019

            
1020
Rollback transaction.
1021
This is same as L<DBI>'s C<rollback>.
1022

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1023
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1024
    
cleanup
yuki-kimoto authored on 2010-08-05
1025
    my $result = $dbi->select(table    => $table,
1026
                              column   => [@column],
1027
                              where    => \%where,
1028
                              append   => $append,
1029
                              relation => \%relation,
1030
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1031

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1032
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1033
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1034
C<relation> and C<filter> arguments.
1035
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1036
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1037
C<append> is a string added at the end of the SQL statement.
1038
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1039

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1040
B<Example:>
update document
yuki-kimoto authored on 2009-11-19
1041

            
added commit method
yuki-kimoto authored on 2010-05-27
1042
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1043
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1044
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1045
    # select * from books where title = ?;
1046
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1047
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1048
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1049
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1050
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1051
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1052
        where  => {id => 1},
1053
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1054
    );
1055
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1056
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1057
    # where books.id = rental.book_id;
1058
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1059
        table    => ['books', 'rental'],
1060
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1061
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1062
    );
1063

            
cleanup
yuki-kimoto authored on 2010-08-09
1064
If you use more complex condition,
1065
you can specify a array reference to C<where> argument.
1066

            
1067
    my $result = $dbi->select(
1068
        table  => 'books',
1069
        column => ['title', 'author'],
1070
        where  => ['{= title} or {like author}',
1071
                   {title => '%Perl%', author => 'Ken'}]
1072
    );
1073

            
1074
First element is a string. it contains tags,
1075
such as "{= title} or {like author}".
1076
Second element is paramters.
1077

            
cleanup
yuki-kimoto authored on 2010-10-17
1078
=head2 C<update>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1079

            
cleanup
yuki-kimoto authored on 2010-10-17
1080
    $dbi->update(table  => $table, 
1081
                 param  => \%params,
1082
                 where  => \%where,
1083
                 append => $append,
1084
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1085

            
cleanup
yuki-kimoto authored on 2010-10-17
1086
Execute update statement.
1087
C<update> method have C<table>, C<param>, C<where>, C<append>
1088
and C<filter> arguments.
1089
C<table> is a table name.
1090
C<param> is column-value pairs. this must be hash reference.
1091
C<where> is where clause. this must be hash reference.
1092
C<append> is a string added at the end of the SQL statement.
1093
C<filter> is filters when parameter binding is executed.
1094
This is overwrites C<default_bind_filter>.
1095
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1096

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1097
B<Example:>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1098

            
cleanup
yuki-kimoto authored on 2010-10-17
1099
    $dbi->update(table  => 'books',
1100
                 param  => {title => 'Perl', author => 'Taro'},
1101
                 where  => {id => 5},
1102
                 append => "some statement",
1103
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1104

            
cleanup
yuki-kimoto authored on 2010-10-17
1105
=head2 C<update_all>
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1106

            
cleanup
yuki-kimoto authored on 2010-10-17
1107
    $dbi->update_all(table  => $table, 
1108
                     param  => \%params,
1109
                     filter => \%filter,
1110
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1111

            
cleanup
yuki-kimoto authored on 2010-10-17
1112
Execute update statement to update all rows.
1113
Arguments is same as C<update> method,
1114
except that C<update_all> don't have C<where> argument.
1115
Return value of C<update_all()> is the count of affected rows.
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1116

            
1117
B<Example:>
packaging one directory
yuki-kimoto authored on 2009-11-16
1118

            
cleanup
yuki-kimoto authored on 2010-10-17
1119
    $dbi->update_all(table  => 'books', 
1120
                     param  => {author => 'taro'},
1121
                     filter => {author => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
1122

            
DBIx::Custom is now stable
yuki-kimoto authored on 2010-09-07
1123
=head1 STABILITY
1124

            
1125
L<DBIx::Custom> is now stable. APIs keep backword compatible in the feature.
1126

            
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1127
=head1 BUGS
1128

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1129
Please tell me bugs if found.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1130

            
1131
C<< <kimoto.yuki at gmail.com> >>
1132

            
1133
L<http://github.com/yuki-kimoto/DBIx-Custom>
1134

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1135
=head1 AUTHOR
1136

            
1137
Yuki Kimoto, C<< <kimoto.yuki at gmail.com> >>
version 0.0901
yuki-kimoto authored on 2009-12-17
1138

            
packaging one directory
yuki-kimoto authored on 2009-11-16
1139
=head1 COPYRIGHT & LICENSE
1140

            
1141
Copyright 2009 Yuki Kimoto, all rights reserved.
1142

            
1143
This program is free software; you can redistribute it and/or modify it
1144
under the same terms as Perl itself.
1145

            
1146
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1147

            
1148