DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1167 lines | 29.695kb
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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
87
sub connect {
removed register_format()
yuki-kimoto authored on 2010-05-26
88
    my $proto = shift;
89
    
90
    # Create
91
    my $self = ref $proto ? $proto : $proto->new(@_);
update document
yuki-kimoto authored on 2010-01-30
92
    
93
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
94
    my $data_source = $self->data_source;
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
95
    
96
    croak qq{"data_source" must be specfied to connect method"}
97
      unless $data_source;
98
    
packaging one directory
yuki-kimoto authored on 2009-11-16
99
    my $user        = $self->user;
100
    my $password    = $self->password;
added dbi_options attribute
kimoto authored on 2010-12-20
101
    my $dbi_options = $self->dbi_options || {};
102
    
103
    $DB::single = 1;
packaging one directory
yuki-kimoto authored on 2009-11-16
104
    
update document
yuki-kimoto authored on 2010-01-30
105
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
106
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
107
        $data_source,
108
        $user,
109
        $password,
110
        {
111
            RaiseError => 1,
112
            PrintError => 0,
113
            AutoCommit => 1,
added dbi_options attribute
kimoto authored on 2010-12-20
114
            %$dbi_options
packaging one directory
yuki-kimoto authored on 2009-11-16
115
        }
116
    )};
117
    
update document
yuki-kimoto authored on 2010-01-30
118
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
119
    croak $@ if $@;
120
    
update document
yuki-kimoto authored on 2010-01-30
121
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
122
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
123
    
packaging one directory
yuki-kimoto authored on 2009-11-16
124
    return $self;
125
}
126

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

            
cleanup
yuki-kimoto authored on 2010-10-17
146
        # Create SQL object
147
        my $builder = $self->query_builder;
148
        
149
        # Create query
150
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
151

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
218
sub DESTROY { }
219

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

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

            
259
        return $result;
260
    }
261
    return $affected;
262
}
263

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

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

            
281
sub insert {
282
    my ($self, %args) = @_;
283

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
311
sub new {
312
    my $self = shift->SUPER::new(@_);
313
    
314
    # Check attribute names
315
    my @attrs = keys %$self;
316
    foreach my $attr (@attrs) {
317
        croak qq{"$attr" is invalid attribute name}
318
          unless $self->can($attr);
319
    }
320
    
321
    return $self;
322
}
323

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
566
=head1 NAME
567

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

            
570
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
571

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

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

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

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

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

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

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

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

            
updated document
yuki-kimoto authored on 2010-08-08
648
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
649

            
removed register_format()
yuki-kimoto authored on 2010-05-26
650
    # Default filter
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
651
    $dbi->default_bind_filter('encode_utf8');
removed register_format()
yuki-kimoto authored on 2010-05-26
652
    $dbi->default_fetch_filter('decode_utf8');
cleanup
yuki-kimoto authored on 2010-08-05
653

            
654
    # Get DBI object
655
    my $dbh = $dbi->dbh;
656

            
657
Fetch row.
658

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
705
    $dbi          = $dbi->cache_method(\&cache_method);
706
    $cache_method = $dbi->cache_method
707

            
708
Method to set and get caches.
709

            
710
B<Example:>
711

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

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

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

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

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

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
742
=head2 C<dbi_options>
743

            
744
    my $dbi_options = $dbi->dbi_options;
745
    $dbi            = $dbi->dbi_options($dbi_options);
746

            
747
DBI options.
748
C<connect()> method use this value to connect the database.
749

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
769
Filter functions.
770
"encode_utf8" and "decode_utf8" is registered by default.
771

            
772
=head2 C<filter_check>
773

            
774
    my $filter_check = $dbi->filter_check;
775
    $dbi             = $dbi->filter_check(0);
776

            
777
Enable filter check. 
778
Default to 1.
779
This check maybe damege performance.
780
If you require performance, set C<filter_check> attribute to 0.
781

            
782
=head2 C<password>
783

            
784
    my $password = $dbi->password;
785
    $dbi         = $dbi->password('lkj&le`@s');
786

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
809
    my $user = $dbi->user;
810
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
811

            
cleanup
yuki-kimoto authored on 2010-10-17
812
User name.
813
C<connect()> method use this value to connect the database.
814
    
815
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
816

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
830
=head2 commit
831

            
832
    $dbi->commit;
833

            
834
Commit transaction.
835
This is same as L<DBI>'s C<commit>.
836

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
847
=head2 C<create_query>
848
    
849
    my $query = $dbi->create_query(
850
        "select * from books where {= author} and {like title};"
851
    );
update document
yuki-kimoto authored on 2009-11-19
852

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
872
    my $result = $dbi->execute(
873
        "select * from books where {= author} and {like title}", 
874
        param => {author => 'Ken', title => '%Perl%'}
875
    );
876
    
877
    while (my $row = $result->fetch) {
878
        my $author = $row->[0];
879
        my $title  = $row->[1];
880
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
881

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

            
884
    my %expand = $dbi->expand($source);
885

            
886
The following hash
887

            
888
    {books => {title => 'Perl', author => 'Ken'}}
889

            
890
is expanded to
891

            
892
    ('books.title' => 'Perl', 'books.author' => 'Ken')
893

            
894
This is used in C<select()>
895

            
896

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

            
cleanup
yuki-kimoto authored on 2010-08-05
900
    $dbi->delete(table  => $table,
901
                 where  => \%where,
902
                 append => $append,
903
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
904

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
905
Execute delete statement.
906
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
907
C<table> is a table name.
908
C<where> is where clause. this must be hash reference.
909
C<append> is a string added at the end of the SQL statement.
910
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
911
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
912

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

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

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

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

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

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

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

            
935
    $dbi->helper(
936
        update_or_insert => sub {
937
            my $self = shift;
938
            # do something
939
        },
940
        find_or_create   => sub {
941
            my $self = shift;
942
            # do something
943
        }
944
    );
945

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

            
948
    $dbi->update_or_insert;
949
    $dbi->find_or_create;
950

            
cleanup
yuki-kimoto authored on 2010-10-17
951
=head2 C<insert>
952

            
953
    $dbi->insert(table  => $table, 
954
                 param  => \%param,
955
                 append => $append,
956
                 filter => \%filter);
957

            
958
Execute insert statement.
959
C<insert> method have C<table>, C<param>, C<append>
960
and C<filter> arguments.
961
C<table> is a table name.
962
C<param> is the pairs of column name value. this must be hash reference.
963
C<append> is a string added at the end of the SQL statement.
964
C<filter> is filters when parameter binding is executed.
965
This is overwrites C<default_bind_filter>.
966
Return value of C<insert()> is the count of affected rows.
967

            
968
B<Example:>
969

            
970
    $dbi->insert(table  => 'books', 
971
                 param  => {title => 'Perl', author => 'Taro'},
972
                 append => "some statement",
973
                 filter => {title => 'encode_utf8'})
974

            
added dbi_options attribute
kimoto authored on 2010-12-20
975
=head2 C<new>
976

            
977
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
978
                                    user => 'ken', password => '!LFKD%$&');
979

            
980
Create a new L<DBIx::Custom> object.
981

            
cleanup
yuki-kimoto authored on 2010-10-17
982
=head2 C<register_filter>
983

            
984
    $dbi->register_filter(%filters);
985
    $dbi->register_filter(\%filters);
986
    
987
Register filter. Registered filters is available in the following attributes
988
or arguments.
989

            
990
=over 4
991

            
992
=item *
993

            
994
C<default_bind_filter>, C<default_fetch_filter>
995

            
996
=item *
997

            
998
C<filter> argument of C<insert()>, C<update()>,
999
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1000
methods
1001

            
1002
=item *
1003

            
1004
C<execute()> method
1005

            
1006
=item *
1007

            
1008
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1009

            
1010
=item *
1011

            
1012
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1013

            
1014
=back
1015

            
1016
B<Example:>
1017

            
1018
    $dbi->register_filter(
1019
        encode_utf8 => sub {
1020
            my $value = shift;
1021
            
1022
            require Encode;
1023
            
1024
            return Encode::encode('UTF-8', $value);
1025
        },
1026
        decode_utf8 => sub {
1027
            my $value = shift;
1028
            
1029
            require Encode;
1030
            
1031
            return Encode::decode('UTF-8', $value)
1032
        }
1033
    );
1034

            
1035
=head2 rollback
1036

            
1037
    $dbi->rollback;
1038

            
1039
Rollback transaction.
1040
This is same as L<DBI>'s C<rollback>.
1041

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1042
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1043
    
cleanup
yuki-kimoto authored on 2010-08-05
1044
    my $result = $dbi->select(table    => $table,
1045
                              column   => [@column],
1046
                              where    => \%where,
1047
                              append   => $append,
1048
                              relation => \%relation,
1049
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1050

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1051
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1052
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1053
C<relation> and C<filter> arguments.
1054
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1055
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1056
C<append> is a string added at the end of the SQL statement.
1057
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1058

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

            
added commit method
yuki-kimoto authored on 2010-05-27
1061
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1062
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1063
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1064
    # select * from books where title = ?;
1065
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1066
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1067
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1068
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1069
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1070
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1071
        where  => {id => 1},
1072
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1073
    );
1074
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1075
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1076
    # where books.id = rental.book_id;
1077
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1078
        table    => ['books', 'rental'],
1079
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1080
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1081
    );
1082

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

            
1086
    my $result = $dbi->select(
1087
        table  => 'books',
1088
        column => ['title', 'author'],
1089
        where  => ['{= title} or {like author}',
1090
                   {title => '%Perl%', author => 'Ken'}]
1091
    );
1092

            
1093
First element is a string. it contains tags,
1094
such as "{= title} or {like author}".
1095
Second element is paramters.
1096

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1099
    $dbi->update(table  => $table, 
1100
                 param  => \%params,
1101
                 where  => \%where,
1102
                 append => $append,
1103
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1104

            
cleanup
yuki-kimoto authored on 2010-10-17
1105
Execute update statement.
1106
C<update> method have C<table>, C<param>, C<where>, C<append>
1107
and C<filter> arguments.
1108
C<table> is a table name.
1109
C<param> is column-value pairs. this must be hash reference.
1110
C<where> is where clause. this must be hash reference.
1111
C<append> is a string added at the end of the SQL statement.
1112
C<filter> is filters when parameter binding is executed.
1113
This is overwrites C<default_bind_filter>.
1114
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1115

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1118
    $dbi->update(table  => 'books',
1119
                 param  => {title => 'Perl', author => 'Taro'},
1120
                 where  => {id => 5},
1121
                 append => "some statement",
1122
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1123

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1126
    $dbi->update_all(table  => $table, 
1127
                     param  => \%params,
1128
                     filter => \%filter,
1129
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1130

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

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

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

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

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

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

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

            
1150
C<< <kimoto.yuki at gmail.com> >>
1151

            
1152
L<http://github.com/yuki-kimoto/DBIx-Custom>
1153

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1154
=head1 AUTHOR
1155

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

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

            
1160
Copyright 2009 Yuki Kimoto, all rights reserved.
1161

            
1162
This program is free software; you can redistribute it and/or modify it
1163
under the same terms as Perl itself.
1164

            
1165
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1166

            
1167