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

            
updated document
yuki-kimoto authored on 2010-10-21
3
our $VERSION = '0.1620';
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
19
                      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
yuki-kimoto authored on 2010-10-17
37
__PACKAGE__->dual_attr('filters', default => sub { {} },
38
                                  inherit => 'hash_copy');
added check_filter attribute
yuki-kimoto authored on 2010-08-08
39
__PACKAGE__->attr(filter_check => 1);
cleanup
yuki-kimoto authored on 2010-10-17
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
);
added check_filter attribute
yuki-kimoto authored on 2010-08-08
61

            
added helper method
yuki-kimoto authored on 2010-10-17
62
our $AUTOLOAD;
63

            
64
sub AUTOLOAD {
65
    my $self = shift;
66

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

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

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
89
sub connect {
removed register_format()
yuki-kimoto authored on 2010-05-26
90
    my $proto = shift;
91
    
92
    # Create
93
    my $self = ref $proto ? $proto : $proto->new(@_);
update document
yuki-kimoto authored on 2010-01-30
94
    
95
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
96
    my $data_source = $self->data_source;
97
    my $user        = $self->user;
98
    my $password    = $self->password;
99
    
removed experimental registe...
yuki-kimoto authored on 2010-08-24
100
    
update document
yuki-kimoto authored on 2010-01-30
101
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
102
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
103
        $data_source,
104
        $user,
105
        $password,
106
        {
107
            RaiseError => 1,
108
            PrintError => 0,
109
            AutoCommit => 1,
110
        }
111
    )};
112
    
update document
yuki-kimoto authored on 2010-01-30
113
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
114
    croak $@ if $@;
115
    
update document
yuki-kimoto authored on 2010-01-30
116
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
117
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
118
    
packaging one directory
yuki-kimoto authored on 2009-11-16
119
    return $self;
120
}
121

            
cleanup
yuki-kimoto authored on 2010-10-17
122
sub create_query {
123
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
124
    
cleanup
yuki-kimoto authored on 2010-10-17
125
    # Cache
126
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
127
    
cleanup
yuki-kimoto authored on 2010-10-17
128
    # Create query
129
    my $query;
130
    if ($cache) {
131
        
132
        # Get query
133
        my $q = $self->cache_method->($self, $source);
134
        
135
        # Create query
136
        $query = DBIx::Custom::Query->new($q) if $q;
137
    }
138
    
139
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
140

            
cleanup
yuki-kimoto authored on 2010-10-17
141
        # Create SQL object
142
        my $builder = $self->query_builder;
143
        
144
        # Create query
145
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
146

            
cleanup
yuki-kimoto authored on 2010-10-17
147
        # Cache query
148
        $self->cache_method->($self, $source,
149
                             {sql     => $query->sql, 
150
                              columns => $query->columns})
151
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
152
    }
153
    
cleanup
yuki-kimoto authored on 2010-10-17
154
    # Prepare statement handle
155
    my $sth;
156
    eval { $sth = $self->dbh->prepare($query->{sql})};
157
    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
158
    
cleanup
yuki-kimoto authored on 2010-10-17
159
    # Set statement handle
160
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
161
    
cleanup
yuki-kimoto authored on 2010-10-17
162
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
163
}
164

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
213
sub DESTROY { }
214

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

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

            
254
        return $result;
255
    }
256
    return $affected;
257
}
258

            
added experimental expand me...
yuki-kimoto authored on 2010-10-20
259
sub expand {
260
    my $self = shift;
261
    my $source = ref $_[0] eq 'HASH' ? $_[0] : {@_};
262
    my $table = (keys %$source)[0];
263
    my $param = $source->{$table};
264
    
265
    # Expand table name
266
    my $expand = {};
267
    foreach my $column (keys %$param) {
268
        $expand->{"$table.$column"} = $param->{$column};
269
    }
270
    
271
    return %$expand;
272
}
273

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

            
276
sub insert {
277
    my ($self, %args) = @_;
278

            
279
    # Check arguments
280
    foreach my $name (keys %args) {
281
        croak qq{"$name" is invalid argument}
282
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
283
    }
284
    
cleanup
yuki-kimoto authored on 2010-10-17
285
    # Arguments
286
    my $table  = $args{table} || '';
287
    my $param  = $args{param} || {};
288
    my $append = $args{append} || '';
289
    my $filter = $args{filter};
290
    
291
    # Insert keys
292
    my @insert_keys = keys %$param;
293
    
294
    # Templte for insert
295
    my $source = "insert into $table {insert_param "
296
               . join(' ', @insert_keys) . '}';
add tests
yuki-kimoto authored on 2010-08-10
297
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
298
    
299
    # Execute query
cleanup
yuki-kimoto authored on 2010-10-17
300
    my $ret_val = $self->execute($source, param  => $param, 
301
                                          filter => $filter);
packaging one directory
yuki-kimoto authored on 2009-11-16
302
    
303
    return $ret_val;
304
}
305

            
cleanup
yuki-kimoto authored on 2010-10-17
306
sub register_filter {
307
    my $invocant = shift;
308
    
309
    # Register filter
310
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
311
    $invocant->filters({%{$invocant->filters}, %$filters});
312
    
313
    return $invocant;
314
}
packaging one directory
yuki-kimoto authored on 2009-11-16
315

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
466
sub _build_bind_values {
467
    my ($self, $query, $params, $filter) = @_;
468
    
469
    # binding values
470
    my @bind_values;
add tests
yuki-kimoto authored on 2010-08-08
471

            
472
    # Filter
473
    $filter ||= {};
474
    
475
    # Parameter
476
    $params ||= {};
477
    
478
    # Check filter
479
    $self->_check_filter($self->filters, $filter,
480
                         $self->default_bind_filter, $params)
481
      if $self->filter_check;
removed reconnect method
yuki-kimoto authored on 2010-05-28
482
    
483
    # Build bind values
484
    my $count = {};
485
    foreach my $column (@{$query->columns}) {
486
        
487
        # Value
488
        my $value = ref $params->{$column} eq 'ARRAY'
489
                  ? $params->{$column}->[$count->{$column} || 0]
490
                  : $params->{$column};
491
        
add tests
yuki-kimoto authored on 2010-08-10
492
        # Filtering
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
493
        my $fname = $filter->{$column} || $self->default_bind_filter || '';
add tests
yuki-kimoto authored on 2010-08-10
494
        my $filter_func = $fname ? $self->filters->{$fname} : undef;
removed reconnect method
yuki-kimoto authored on 2010-05-28
495
        push @bind_values, $filter_func
496
                         ? $filter_func->($value)
497
                         : $value;
498
        
499
        # Count up 
500
        $count->{$column}++;
501
    }
502
    
503
    return \@bind_values;
504
}
505

            
add tests
yuki-kimoto authored on 2010-08-08
506
sub _check_filter {
507
    my ($self, $filters, $filter, $default_filter, $params) = @_;
508
    
509
    # Filter name not exists
510
    foreach my $fname (values %$filter) {
511
        croak qq{Bind filter "$fname" is not registered}
512
          unless exists $filters->{$fname};
513
    }
514
    
515
    # Default filter name not exists
516
    croak qq{Default bind filter "$default_filter" is not registered}
517
      if $default_filter && ! exists $filters->{$default_filter};
518
    
519
    # Column name not exists
520
    foreach my $column (keys %$filter) {
521
        
522
        croak qq{Column name "$column" in bind filter is not found in paramters}
523
          unless exists $params->{$column};
524
    }
525
}
526

            
cleanup
yuki-kimoto authored on 2010-10-17
527
sub _croak {
528
    my ($self, $error, $append) = @_;
529
    $append ||= "";
530
    
531
    # Verbose
532
    if ($Carp::Verbose) { croak $error }
533
    
534
    # Not verbose
535
    else {
536
        
537
        # Remove line and module infromation
538
        my $at_pos = rindex($error, ' at ');
539
        $error = substr($error, 0, $at_pos);
540
        $error =~ s/\s+$//;
541
        
542
        croak "$error$append";
543
    }
544
}
545

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
548
=head1 NAME
549

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

            
552
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
553

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
562
    # Insert 
563
    $dbi->insert(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
564
                 param  => {title => 'Perl', author => 'Ken'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
565
                 filter => {title => 'encode_utf8'});
566
    
567
    # Update 
568
    $dbi->update(table  => 'books', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
569
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
570
                 where  => {id => 5},
571
                 filter => {title => 'encode_utf8'});
572
    
573
    # Update all
574
    $dbi->update_all(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
575
                     param  => {title => 'Perl'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
576
                     filter => {title => 'encode_utf8'});
577
    
578
    # Delete
579
    $dbi->delete(table  => 'books',
580
                 where  => {author => 'Ken'},
581
                 filter => {title => 'encode_utf8'});
582
    
583
    # Delete all
584
    $dbi->delete_all(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
585

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
588
    # Select
589
    my $result = $dbi->select(table => 'books');
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
590
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
591
    # Select, more complex
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
592
    my $result = $dbi->select(
update document
yuki-kimoto authored on 2010-05-27
593
        table  => 'books',
594
        column => [qw/author title/],
595
        where  => {author => 'Ken'},
updated document
yuki-kimoto authored on 2010-08-08
596
        append => 'order by id limit 5',
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
597
        filter => {title => 'encode_utf8'}
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
598
    );
added commit method
yuki-kimoto authored on 2010-05-27
599
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
600
    # Select, join table
added commit method
yuki-kimoto authored on 2010-05-27
601
    my $result = $dbi->select(
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
602
        table    => ['books', 'rental'],
603
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
604
        relation => {'books.id' => 'rental.book_id'}
605
    );
updated document
yuki-kimoto authored on 2010-08-08
606
    
607
    # Select, more flexible where
608
    my $result = $dbi->select(
609
        table  => 'books',
610
        where  => ['{= author} and {like title}', 
611
                   {author => 'Ken', title => '%Perl%'}]
612
    );
cleanup
yuki-kimoto authored on 2010-08-05
613

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
616
    # Execute SQL
removed register_format()
yuki-kimoto authored on 2010-05-26
617
    $dbi->execute("select title from books");
618
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
619
    # Execute SQL with hash binding and filtering
updated document
yuki-kimoto authored on 2010-08-08
620
    $dbi->execute("select id from books where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
621
                  param  => {author => 'ken', title => '%Perl%'},
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
622
                  filter => {title => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
623

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

            
updated document
yuki-kimoto authored on 2010-08-08
630
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
631

            
removed register_format()
yuki-kimoto authored on 2010-05-26
632
    # Default filter
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
633
    $dbi->default_bind_filter('encode_utf8');
removed register_format()
yuki-kimoto authored on 2010-05-26
634
    $dbi->default_fetch_filter('decode_utf8');
cleanup
yuki-kimoto authored on 2010-08-05
635

            
636
    # Get DBI object
637
    my $dbh = $dbi->dbh;
638

            
639
Fetch row.
640

            
removed register_format()
yuki-kimoto authored on 2010-05-26
641
    # Fetch
642
    while (my $row = $result->fetch) {
643
        # ...
644
    }
645
    
646
    # Fetch hash
647
    while (my $row = $result->fetch_hash) {
648
        
649
    }
650
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
651
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
652

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
687
    $dbi          = $dbi->cache_method(\&cache_method);
688
    $cache_method = $dbi->cache_method
689

            
690
Method to set and get caches.
691

            
692
B<Example:>
693

            
694
    $dbi->cache_method(
695
        sub {
696
            my $self = shift;
697
            
698
            $self->{_cached} ||= {};
699
            
700
            if (@_ > 1) {
701
                $self->{_cached}{$_[0]} = $_[1] 
702
            }
703
            else {
704
                return $self->{_cached}{$_[0]}
705
            }
706
        }
707
    );
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
708

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
743
Filter functions.
744
"encode_utf8" and "decode_utf8" is registered by default.
745

            
746
=head2 C<filter_check>
747

            
748
    my $filter_check = $dbi->filter_check;
749
    $dbi             = $dbi->filter_check(0);
750

            
751
Enable filter check. 
752
Default to 1.
753
This check maybe damege performance.
754
If you require performance, set C<filter_check> attribute to 0.
755

            
756
=head2 C<password>
757

            
758
    my $password = $dbi->password;
759
    $dbi         = $dbi->password('lkj&le`@s');
760

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
783
    my $user = $dbi->user;
784
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
785

            
cleanup
yuki-kimoto authored on 2010-10-17
786
User name.
787
C<connect()> method use this value to connect the database.
788
    
789
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
790

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
804
=head2 commit
805

            
806
    $dbi->commit;
807

            
808
Commit transaction.
809
This is same as L<DBI>'s C<commit>.
810

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
821
=head2 C<create_query>
822
    
823
    my $query = $dbi->create_query(
824
        "select * from books where {= author} and {like title};"
825
    );
update document
yuki-kimoto authored on 2009-11-19
826

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
846
    my $result = $dbi->execute(
847
        "select * from books where {= author} and {like title}", 
848
        param => {author => 'Ken', title => '%Perl%'}
849
    );
850
    
851
    while (my $row = $result->fetch) {
852
        my $author = $row->[0];
853
        my $title  = $row->[1];
854
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
855

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

            
858
    my %expand = $dbi->expand($source);
859

            
860
The following hash
861

            
862
    {books => {title => 'Perl', author => 'Ken'}}
863

            
864
is expanded to
865

            
866
    ('books.title' => 'Perl', 'books.author' => 'Ken')
867

            
868
This is used in C<select()>
869

            
870

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

            
cleanup
yuki-kimoto authored on 2010-08-05
874
    $dbi->delete(table  => $table,
875
                 where  => \%where,
876
                 append => $append,
877
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
878

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
879
Execute delete statement.
880
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
881
C<table> is a table name.
882
C<where> is where clause. this must be hash reference.
883
C<append> is a string added at the end of the SQL statement.
884
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
885
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
886

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

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

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

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

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

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

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

            
909
    $dbi->helper(
910
        update_or_insert => sub {
911
            my $self = shift;
912
            # do something
913
        },
914
        find_or_create   => sub {
915
            my $self = shift;
916
            # do something
917
        }
918
    );
919

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

            
922
    $dbi->update_or_insert;
923
    $dbi->find_or_create;
924

            
cleanup
yuki-kimoto authored on 2010-10-17
925
=head2 C<insert>
926

            
927
    $dbi->insert(table  => $table, 
928
                 param  => \%param,
929
                 append => $append,
930
                 filter => \%filter);
931

            
932
Execute insert statement.
933
C<insert> method have C<table>, C<param>, C<append>
934
and C<filter> arguments.
935
C<table> is a table name.
936
C<param> is the pairs of column name value. this must be hash reference.
937
C<append> is a string added at the end of the SQL statement.
938
C<filter> is filters when parameter binding is executed.
939
This is overwrites C<default_bind_filter>.
940
Return value of C<insert()> is the count of affected rows.
941

            
942
B<Example:>
943

            
944
    $dbi->insert(table  => 'books', 
945
                 param  => {title => 'Perl', author => 'Taro'},
946
                 append => "some statement",
947
                 filter => {title => 'encode_utf8'})
948

            
949
=head2 C<register_filter>
950

            
951
    $dbi->register_filter(%filters);
952
    $dbi->register_filter(\%filters);
953
    
954
Register filter. Registered filters is available in the following attributes
955
or arguments.
956

            
957
=over 4
958

            
959
=item *
960

            
961
C<default_bind_filter>, C<default_fetch_filter>
962

            
963
=item *
964

            
965
C<filter> argument of C<insert()>, C<update()>,
966
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
967
methods
968

            
969
=item *
970

            
971
C<execute()> method
972

            
973
=item *
974

            
975
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
976

            
977
=item *
978

            
979
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
980

            
981
=back
982

            
983
B<Example:>
984

            
985
    $dbi->register_filter(
986
        encode_utf8 => sub {
987
            my $value = shift;
988
            
989
            require Encode;
990
            
991
            return Encode::encode('UTF-8', $value);
992
        },
993
        decode_utf8 => sub {
994
            my $value = shift;
995
            
996
            require Encode;
997
            
998
            return Encode::decode('UTF-8', $value)
999
        }
1000
    );
1001

            
1002
=head2 rollback
1003

            
1004
    $dbi->rollback;
1005

            
1006
Rollback transaction.
1007
This is same as L<DBI>'s C<rollback>.
1008

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1009
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1010
    
cleanup
yuki-kimoto authored on 2010-08-05
1011
    my $result = $dbi->select(table    => $table,
1012
                              column   => [@column],
1013
                              where    => \%where,
1014
                              append   => $append,
1015
                              relation => \%relation,
1016
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1017

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1018
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1019
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1020
C<relation> and C<filter> arguments.
1021
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1022
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1023
C<append> is a string added at the end of the SQL statement.
1024
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1025

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

            
added commit method
yuki-kimoto authored on 2010-05-27
1028
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1029
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1030
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1031
    # select * from books where title = ?;
1032
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1033
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1034
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1035
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1036
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1037
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1038
        where  => {id => 1},
1039
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1040
    );
1041
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1042
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1043
    # where books.id = rental.book_id;
1044
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1045
        table    => ['books', 'rental'],
1046
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1047
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1048
    );
1049

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

            
1053
    my $result = $dbi->select(
1054
        table  => 'books',
1055
        column => ['title', 'author'],
1056
        where  => ['{= title} or {like author}',
1057
                   {title => '%Perl%', author => 'Ken'}]
1058
    );
1059

            
1060
First element is a string. it contains tags,
1061
such as "{= title} or {like author}".
1062
Second element is paramters.
1063

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1066
    $dbi->update(table  => $table, 
1067
                 param  => \%params,
1068
                 where  => \%where,
1069
                 append => $append,
1070
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1071

            
cleanup
yuki-kimoto authored on 2010-10-17
1072
Execute update statement.
1073
C<update> method have C<table>, C<param>, C<where>, C<append>
1074
and C<filter> arguments.
1075
C<table> is a table name.
1076
C<param> is column-value pairs. this must be hash reference.
1077
C<where> is where clause. this must be hash reference.
1078
C<append> is a string added at the end of the SQL statement.
1079
C<filter> is filters when parameter binding is executed.
1080
This is overwrites C<default_bind_filter>.
1081
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1082

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1085
    $dbi->update(table  => 'books',
1086
                 param  => {title => 'Perl', author => 'Taro'},
1087
                 where  => {id => 5},
1088
                 append => "some statement",
1089
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1090

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1093
    $dbi->update_all(table  => $table, 
1094
                     param  => \%params,
1095
                     filter => \%filter,
1096
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1097

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

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

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

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

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

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

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

            
1117
C<< <kimoto.yuki at gmail.com> >>
1118

            
1119
L<http://github.com/yuki-kimoto/DBIx-Custom>
1120

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1121
=head1 AUTHOR
1122

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

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

            
1127
Copyright 2009 Yuki Kimoto, all rights reserved.
1128

            
1129
This program is free software; you can redistribute it and/or modify it
1130
under the same terms as Perl itself.
1131

            
1132
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1133

            
1134