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

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
3
our $VERSION = '0.1623';
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-12-21
18
__PACKAGE__->attr([qw/data_source dbh
19
                      dbi_options 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

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
77
sub auto_filter {
78
    my $self = shift;
79
    
80
    # Table
81
    my $table = shift;
82
    
83
    # Column infomations
84
    my @cs = @_;
85
    
86
    # Initialize filters
87
    $self->{_auto_bind_filter} ||= {};
88
    $self->{_auto_fetch_filter} ||= {};
89
    
90
    # Create auto filters
91
    foreach my $c (@cs) {
92
        croak "Usage \$dbi->auto_filter(" .
93
              "TABLE, [COLUMN, BIND_FILTER, FETCH_FILTER], [...])"
94
          unless ref $c eq 'ARRAY' && @$c == 3;
95
        
96
        # Column
97
        my $column = $c->[0];
98
        
99
        # Bind filter
100
        my $bind_filter  = $c->[1];
cleanup
Yuki Kimoto authored on 2010-12-21
101
        if (ref $bind_filter eq 'CODE') {
102
	        $self->{_auto_bind_filter}{$table}{$column}
103
	          = $bind_filter;
104
	        $self->{_auto_bind_filter}{$table}{"$table.$column"}
105
	          = $bind_filter;
106
        }
107
        else {
108
	        croak qq{"$bind_filter" is not registered}
109
	          unless exists $self->filters->{$bind_filter};
110
	        
111
	        $self->{_auto_bind_filter}{$table}{$column}
112
	          = $self->filters->{$bind_filter};
113
	        $self->{_auto_bind_filter}{$table}{"$table.$column"}
114
	          = $self->filters->{$bind_filter};
115
	    }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
116
        
117
        # Fetch filter
118
        my $fetch_filter = $c->[2];
cleanup
Yuki Kimoto authored on 2010-12-21
119
        if (ref $fetch_filter eq 'CODE') {
120
	        $self->{_auto_fetch_filter}{$table}{$column}
121
	          = $fetch_filter;
122
	        $self->{_auto_fetch_filter}{$table}{"$table.$column"}
123
	          = $fetch_filter;
124
        }
125
        else {
126
            croak qq{"$fetch_filter" is not registered}
127
              unless exists $self->filters->{$fetch_filter};
128
            $self->{_auto_fetch_filter}{$table}{$column}
129
              = $self->filters->{$fetch_filter};
130
            $self->{_auto_fetch_filter}{$table}{"$table.$column"}
131
              = $self->filters->{$fetch_filter};
132
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
133
    }
134
    
135
    return $self;
136
}
137

            
added helper method
yuki-kimoto authored on 2010-10-17
138
sub helper {
139
    my $self = shift;
140
    
141
    # Merge
142
    my $helpers = ref $_[0] eq 'HASH' ? $_[0] : {@_};
143
    $self->{_helpers} = {%{$self->{_helpers} || {}}, %$helpers};
144
    
145
    return $self;
146
}
147

            
packaging one directory
yuki-kimoto authored on 2009-11-16
148
sub connect {
removed register_format()
yuki-kimoto authored on 2010-05-26
149
    my $proto = shift;
150
    
151
    # Create
152
    my $self = ref $proto ? $proto : $proto->new(@_);
update document
yuki-kimoto authored on 2010-01-30
153
    
154
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
155
    my $data_source = $self->data_source;
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
156
    
157
    croak qq{"data_source" must be specfied to connect method"}
158
      unless $data_source;
159
    
packaging one directory
yuki-kimoto authored on 2009-11-16
160
    my $user        = $self->user;
161
    my $password    = $self->password;
added dbi_options attribute
kimoto authored on 2010-12-20
162
    my $dbi_options = $self->dbi_options || {};
163
    
update document
yuki-kimoto authored on 2010-01-30
164
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
165
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
166
        $data_source,
167
        $user,
168
        $password,
169
        {
170
            RaiseError => 1,
171
            PrintError => 0,
172
            AutoCommit => 1,
added dbi_options attribute
kimoto authored on 2010-12-20
173
            %$dbi_options
packaging one directory
yuki-kimoto authored on 2009-11-16
174
        }
175
    )};
176
    
update document
yuki-kimoto authored on 2010-01-30
177
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
178
    croak $@ if $@;
179
    
update document
yuki-kimoto authored on 2010-01-30
180
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
181
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
182
    
packaging one directory
yuki-kimoto authored on 2009-11-16
183
    return $self;
184
}
185

            
cleanup
yuki-kimoto authored on 2010-10-17
186
sub create_query {
187
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
188
    
cleanup
yuki-kimoto authored on 2010-10-17
189
    # Cache
190
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
191
    
cleanup
yuki-kimoto authored on 2010-10-17
192
    # Create query
193
    my $query;
194
    if ($cache) {
195
        
196
        # Get query
197
        my $q = $self->cache_method->($self, $source);
198
        
199
        # Create query
200
        $query = DBIx::Custom::Query->new($q) if $q;
201
    }
202
    
203
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
204

            
cleanup
yuki-kimoto authored on 2010-10-17
205
        # Create SQL object
206
        my $builder = $self->query_builder;
207
        
208
        # Create query
209
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
210

            
cleanup
yuki-kimoto authored on 2010-10-17
211
        # Cache query
212
        $self->cache_method->($self, $source,
213
                             {sql     => $query->sql, 
214
                              columns => $query->columns})
215
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
216
    }
217
    
cleanup
yuki-kimoto authored on 2010-10-17
218
    # Prepare statement handle
219
    my $sth;
220
    eval { $sth = $self->dbh->prepare($query->{sql})};
221
    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
222
    
cleanup
yuki-kimoto authored on 2010-10-17
223
    # Set statement handle
224
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
225
    
cleanup
yuki-kimoto authored on 2010-10-17
226
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
227
}
228

            
cleanup
Yuki Kimoto authored on 2010-12-21
229
sub default_bind_filter {
230
    my $self = shift;
231
    my $fname = $_[0];
232
    
233
    if (@_ && !$fname) {
234
        $self->{_default_bind_filter} = undef;
235
    }
236
    else {
237
        croak qq{"$fname" is not registered}
238
          unless exists $self->filters->{$fname};
239
    
240
        $self->{_default_bind_filter} = $self->filters->{$fname};
241
    }
242
    
243
    return $self;
244
}
245

            
246
sub default_fetch_filter {
247
    my $self = shift;
248
    my $fname = $_[0];
249
    
250
    if (@_ && !$fname) {
251
        $self->{_default_fetch_filter} = undef;
252
    }
253
    else {
254
        croak qq{"$fname" is not registered}
255
          unless exists $self->filters->{$fname};
256
    
257
        $self->{_default_fetch_filter} = $self->filters->{$fname};
258
    }
259
    
260
    return $self;
261
}
262

            
cleanup
yuki-kimoto authored on 2010-10-17
263
our %VALID_DELETE_ARGS
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
264
  = map { $_ => 1 } qw/auto_filter_table table where append filter allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
265

            
cleanup
yuki-kimoto authored on 2010-10-17
266
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
267
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
268
    
269
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
270
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
271
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
272
          unless $VALID_DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
273
    }
274
    
275
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
276
    my $table            = $args{table} || '';
277
    my $where            = $args{where} || {};
cleanup
yuki-kimoto authored on 2010-10-17
278
    my $append = $args{append};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
279
    my $filter           = $args{filter};
cleanup
yuki-kimoto authored on 2010-10-17
280
    my $allow_delete_all = $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
281

            
282
    my $auto_filter_table = exists $args{auto_filter_table}
283
                          ? $args{auto_filter_table}
284
                          : [$table];
285
    $auto_filter_table ||= [];    
286

            
packaging one directory
yuki-kimoto authored on 2009-11-16
287
    # Where keys
removed register_format()
yuki-kimoto authored on 2010-05-26
288
    my @where_keys = keys %$where;
packaging one directory
yuki-kimoto authored on 2009-11-16
289
    
290
    # Not exists where keys
add tests
yuki-kimoto authored on 2010-08-10
291
    croak qq{"where" argument must be specified and } .
292
          qq{contains the pairs of column name and value}
cleanup
yuki-kimoto authored on 2010-10-17
293
      if !@where_keys && !$allow_delete_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
294
    
295
    # Where clause
296
    my $where_clause = '';
297
    if (@where_keys) {
298
        $where_clause = 'where ';
add tests
yuki-kimoto authored on 2010-08-10
299
        $where_clause .= "{= $_} and " for @where_keys;
packaging one directory
yuki-kimoto authored on 2009-11-16
300
        $where_clause =~ s/ and $//;
301
    }
302
    
add tests
yuki-kimoto authored on 2010-08-10
303
    # Source of SQL
cleanup
yuki-kimoto authored on 2010-10-17
304
    my $source = "delete from $table $where_clause";
add tests
yuki-kimoto authored on 2010-08-10
305
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
306
    
307
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
308
    my $ret_val = $self->execute(
309
        $source, param  => $where, filter => $filter,
310
        auto_filter_table => $auto_filter_table);
packaging one directory
yuki-kimoto authored on 2009-11-16
311
    
312
    return $ret_val;
313
}
314

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

            
added helper method
yuki-kimoto authored on 2010-10-17
317
sub DESTROY { }
318

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
319
our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter auto_filter_table/;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
320

            
cleanup
yuki-kimoto authored on 2010-10-17
321
sub execute{
322
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
323
    
324
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
325
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
326
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
327
          unless $VALID_EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
328
    }
329
    
cleanup
yuki-kimoto authored on 2010-10-17
330
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
331
    
cleanup
yuki-kimoto authored on 2010-10-17
332
    # First argument is the soruce of SQL
333
    $query = $self->create_query($query)
334
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
335
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
336
    # Auto filter
337
    my $auto_filter = {};
338
    my $auto_filter_tables = $args{auto_filter_table} || [];
339
    foreach my $table (@$auto_filter_tables) {
340
        $auto_filter = {
341
            %$auto_filter,
342
            %{$self->{_auto_bind_filter}->{$table} || {}}
343
        }
344
    }
345
    
346
    # Filter
cleanup
yuki-kimoto authored on 2010-10-17
347
    my $filter = $args{filter} || $query->filter || {};
cleanup
Yuki Kimoto authored on 2010-12-21
348
    foreach my $column (keys %$filter) {
349
        my $fname = $filter->{$column};
350
        unless (ref $fname eq 'CODE') {
351
          croak qq{"$fname" is not registered"}
352
            unless exists $self->filters->{$fname};
353
          
354
          $filter->{$column} = $self->filters->{$fname};
355
        }
356
    }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
357
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
358
    
cleanup
yuki-kimoto authored on 2010-10-17
359
    # Create bind value
360
    my $bind_values = $self->_build_bind_values($query, $params, $filter);
361
    
362
    # Execute
363
    my $sth      = $query->sth;
364
    my $affected;
365
    eval {$affected = $sth->execute(@$bind_values)};
366
    $self->_croak($@) if $@;
367
    
368
    # Return resultset if select statement is executed
369
    if ($sth->{NUM_OF_FIELDS}) {
370
        
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
371
        # Auto fetch filter
372
        my $auto_fetch_filter = {};
373
	    foreach my $table (@$auto_filter_tables) {
374
	        $auto_fetch_filter = {
375
	            %$auto_filter,
376
	            %{$self->{_auto_fetch_filter}{$table} || {}}
377
	        }
378
	    }
379
	    
380
		# Result
381
		my $result = $self->result_class->new(
cleanup
yuki-kimoto authored on 2010-10-17
382
            sth            => $sth,
383
            filters        => $self->filters,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
384
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2010-12-21
385
            _auto_filter   => $auto_fetch_filter || {},
386
            _default_filter => $self->{_default_fetch_filter}
cleanup
yuki-kimoto authored on 2010-10-17
387
        );
388

            
389
        return $result;
390
    }
391
    return $affected;
392
}
393

            
added experimental expand me...
yuki-kimoto authored on 2010-10-20
394
sub expand {
395
    my $self = shift;
396
    my $source = ref $_[0] eq 'HASH' ? $_[0] : {@_};
397
    my $table = (keys %$source)[0];
398
    my $param = $source->{$table};
399
    
400
    # Expand table name
401
    my $expand = {};
402
    foreach my $column (keys %$param) {
403
        $expand->{"$table.$column"} = $param->{$column};
404
    }
405
    
406
    return %$expand;
407
}
408

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
409
our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append
410
                                            filter auto_filter_table/;
cleanup
yuki-kimoto authored on 2010-10-17
411
sub insert {
412
    my ($self, %args) = @_;
413

            
414
    # Check arguments
415
    foreach my $name (keys %args) {
416
        croak qq{"$name" is invalid argument}
417
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
418
    }
419
    
cleanup
yuki-kimoto authored on 2010-10-17
420
    # Arguments
421
    my $table  = $args{table} || '';
422
    my $param  = $args{param} || {};
423
    my $append = $args{append} || '';
424
    my $filter = $args{filter};
425
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
426
    my $auto_filter_table = exists $args{auto_filter_table}
427
                          ? $args{auto_filter_table}
428
                          : [$table];
429
    $auto_filter_table ||= [];
430
    
cleanup
yuki-kimoto authored on 2010-10-17
431
    # Insert keys
432
    my @insert_keys = keys %$param;
433
    
434
    # Templte for insert
435
    my $source = "insert into $table {insert_param "
436
               . join(' ', @insert_keys) . '}';
add tests
yuki-kimoto authored on 2010-08-10
437
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
438
    
439
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
440
    my $ret_val = $self->execute(
441
        $source,
442
        param  => $param,
443
        filter => $filter,
444
        auto_filter_table => $auto_filter_table
445
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
446
    
447
    return $ret_val;
448
}
449

            
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
450
sub iterate_all_columns {
451
    my ($self, $cb) = @_;
452
    
453
    # Iterate all tables
454
    my $sth_tables = $self->dbh->table_info;
455
    while (my $table_info = $sth_tables->fetchrow_hashref) {
456
        
457
        # Table
458
        my $table = $table_info->{TABLE_NAME};
459
        
460
        # Iterate all columns
461
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
462
        while (my $column_info = $sth_columns->fetchrow_hashref) {
463
            my $column = $column_info->{COLUMN_NAME};
464
            $cb->($table, $column, $column_info);
465
        }
466
    }
467
}
468

            
added dbi_options attribute
kimoto authored on 2010-12-20
469
sub new {
470
    my $self = shift->SUPER::new(@_);
471
    
472
    # Check attribute names
473
    my @attrs = keys %$self;
474
    foreach my $attr (@attrs) {
475
        croak qq{"$attr" is invalid attribute name}
476
          unless $self->can($attr);
477
    }
478
    
479
    return $self;
480
}
481

            
cleanup
yuki-kimoto authored on 2010-10-17
482
sub register_filter {
483
    my $invocant = shift;
484
    
485
    # Register filter
486
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
487
    $invocant->filters({%{$invocant->filters}, %$filters});
488
    
489
    return $invocant;
490
}
packaging one directory
yuki-kimoto authored on 2009-11-16
491

            
refactoring select
yuki-kimoto authored on 2010-04-28
492
our %VALID_SELECT_ARGS
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
493
  = map { $_ => 1 } qw/auto_filter_table table column where append relation filter param/;
refactoring select
yuki-kimoto authored on 2010-04-28
494

            
packaging one directory
yuki-kimoto authored on 2009-11-16
495
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
496
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
497
    
refactoring select
yuki-kimoto authored on 2010-04-28
498
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
499
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
500
        croak qq{"$name" is invalid argument}
refactoring select
yuki-kimoto authored on 2010-04-28
501
          unless $VALID_SELECT_ARGS{$name};
502
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
503
    
refactoring select
yuki-kimoto authored on 2010-04-28
504
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
505
    my $tables = $args{table} || [];
removed register_format()
yuki-kimoto authored on 2010-05-26
506
    $tables = [$tables] unless ref $tables eq 'ARRAY';
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
507
    my $columns  = $args{column} || [];
update document
yuki-kimoto authored on 2010-08-07
508
    my $where    = $args{where};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
509
    my $relation = $args{relation};
510
    my $append   = $args{append};
511
    my $filter   = $args{filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
512

            
513
    my $auto_filter_table = exists $args{auto_filter_table}
514
                          ? $args{auto_filter_table}
515
                          : $tables;
packaging one directory
yuki-kimoto authored on 2009-11-16
516
    
add tests
yuki-kimoto authored on 2010-08-10
517
    # Source of SQL
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
518
    my $source = 'select ';
packaging one directory
yuki-kimoto authored on 2009-11-16
519
    
added commit method
yuki-kimoto authored on 2010-05-27
520
    # Column clause
packaging one directory
yuki-kimoto authored on 2009-11-16
521
    if (@$columns) {
522
        foreach my $column (@$columns) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
523
            $source .= "$column, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
524
        }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
525
        $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
526
    }
527
    else {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
528
        $source .= '* ';
packaging one directory
yuki-kimoto authored on 2009-11-16
529
    }
530
    
added commit method
yuki-kimoto authored on 2010-05-27
531
    # Table
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
532
    $source .= 'from ';
packaging one directory
yuki-kimoto authored on 2009-11-16
533
    foreach my $table (@$tables) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
534
        $source .= "$table, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
535
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
536
    $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
537
    
added commit method
yuki-kimoto authored on 2010-05-27
538
    # Where clause
update document
yuki-kimoto authored on 2010-08-07
539
    my $param;
540
    if (ref $where eq 'HASH') {
541
        $param = $where;
542
        $source .= 'where (';
543
        foreach my $where_key (keys %$where) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
544
            $source .= "{= $where_key} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
545
        }
update document
yuki-kimoto authored on 2010-08-07
546
        $source =~ s/ and $//;
547
        $source .= ') ';
548
    }
549
    elsif (ref $where eq 'ARRAY') {
550
        my$where_str = $where->[0] || '';
551
        $param = $where->[1];
552
        
553
        $source .= "where ($where_str) ";
packaging one directory
yuki-kimoto authored on 2009-11-16
554
    }
555
    
added commit method
yuki-kimoto authored on 2010-05-27
556
    # Relation
557
    if ($relation) {
update document
yuki-kimoto authored on 2010-08-07
558
        $source .= $where ? "and " : "where ";
added commit method
yuki-kimoto authored on 2010-05-27
559
        foreach my $rkey (keys %$relation) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
560
            $source .= "$rkey = " . $relation->{$rkey} . " and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
561
        }
562
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
563
    $source =~ s/ and $//;
added commit method
yuki-kimoto authored on 2010-05-27
564
    
565
    # Append some statement
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
566
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
567
    
568
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
569
    my $result = $self->execute(
570
        $source, param  => $param, filter => $filter,
571
        auto_filter_table => $auto_filter_table);    
packaging one directory
yuki-kimoto authored on 2009-11-16
572
    
573
    return $result;
574
}
575

            
cleanup
yuki-kimoto authored on 2010-10-17
576
our %VALID_UPDATE_ARGS
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
577
  = map { $_ => 1 } qw/auto_filter_table table param
578
                       where append filter allow_update_all/;
cleanup
yuki-kimoto authored on 2010-10-17
579

            
580
sub update {
581
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
582
    
cleanup
yuki-kimoto authored on 2010-10-17
583
    # Check arguments
584
    foreach my $name (keys %args) {
585
        croak qq{"$name" is invalid argument}
586
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
587
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
588
    
cleanup
yuki-kimoto authored on 2010-10-17
589
    # Arguments
590
    my $table            = $args{table} || '';
591
    my $param            = $args{param} || {};
592
    my $where            = $args{where} || {};
593
    my $append = $args{append} || '';
594
    my $filter           = $args{filter};
595
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
596
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
597
    my $auto_filter_table = exists $args{auto_filter_table}
598
                          ? $args{auto_filter_table}
599
                          : [$table];
600
    $auto_filter_table ||= [];
601
    
cleanup
yuki-kimoto authored on 2010-10-17
602
    # Update keys
603
    my @update_keys = keys %$param;
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
604
    
cleanup
yuki-kimoto authored on 2010-10-17
605
    # Where keys
606
    my @where_keys = keys %$where;
removed reconnect method
yuki-kimoto authored on 2010-05-28
607
    
cleanup
yuki-kimoto authored on 2010-10-17
608
    # Not exists where keys
609
    croak qq{"where" argument must be specified and } .
610
          qq{contains the pairs of column name and value}
611
      if !@where_keys && !$allow_update_all;
removed experimental registe...
yuki-kimoto authored on 2010-08-24
612
    
cleanup
yuki-kimoto authored on 2010-10-17
613
    # Update clause
614
    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
removed experimental registe...
yuki-kimoto authored on 2010-08-24
615
    
cleanup
yuki-kimoto authored on 2010-10-17
616
    # Where clause
617
    my $where_clause = '';
618
    my $new_where = {};
removed reconnect method
yuki-kimoto authored on 2010-05-28
619
    
cleanup
yuki-kimoto authored on 2010-10-17
620
    if (@where_keys) {
621
        $where_clause = 'where ';
622
        $where_clause .= "{= $_} and " for @where_keys;
623
        $where_clause =~ s/ and $//;
removed reconnect method
yuki-kimoto authored on 2010-05-28
624
    }
625
    
cleanup
yuki-kimoto authored on 2010-10-17
626
    # Source of SQL
627
    my $source = "update $table $update_clause $where_clause";
628
    $source .= " $append" if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
629
    
cleanup
yuki-kimoto authored on 2010-10-17
630
    # Rearrange parameters
631
    foreach my $wkey (@where_keys) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
632
        
cleanup
yuki-kimoto authored on 2010-10-17
633
        if (exists $param->{$wkey}) {
634
            $param->{$wkey} = [$param->{$wkey}]
635
              unless ref $param->{$wkey} eq 'ARRAY';
636
            
637
            push @{$param->{$wkey}}, $where->{$wkey};
638
        }
639
        else {
640
            $param->{$wkey} = $where->{$wkey};
641
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
642
    }
cleanup
yuki-kimoto authored on 2010-10-17
643
    
644
    # Execute query
645
    my $ret_val = $self->execute($source, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
646
                                 filter => $filter,
647
                                 auto_filter_table => $auto_filter_table);
cleanup
yuki-kimoto authored on 2010-10-17
648
    
649
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
650
}
651

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
654
sub _build_bind_values {
655
    my ($self, $query, $params, $filter) = @_;
656
    
657
    # binding values
658
    my @bind_values;
add tests
yuki-kimoto authored on 2010-08-08
659

            
660
    # Filter
661
    $filter ||= {};
662
    
663
    # Parameter
664
    $params ||= {};
665
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
666
    # Build bind values
667
    my $count = {};
668
    foreach my $column (@{$query->columns}) {
669
        
670
        # Value
671
        my $value = ref $params->{$column} eq 'ARRAY'
672
                  ? $params->{$column}->[$count->{$column} || 0]
673
                  : $params->{$column};
674
        
add tests
yuki-kimoto authored on 2010-08-10
675
        # Filtering
cleanup
Yuki Kimoto authored on 2010-12-21
676
        my $f = $filter->{$column} || $self->{_default_bind_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
677
        
cleanup
Yuki Kimoto authored on 2010-12-21
678
        push @bind_values, $f ? $f->($value) : $value;
removed reconnect method
yuki-kimoto authored on 2010-05-28
679
        
680
        # Count up 
681
        $count->{$column}++;
682
    }
683
    
684
    return \@bind_values;
685
}
686

            
cleanup
yuki-kimoto authored on 2010-10-17
687
sub _croak {
688
    my ($self, $error, $append) = @_;
689
    $append ||= "";
690
    
691
    # Verbose
692
    if ($Carp::Verbose) { croak $error }
693
    
694
    # Not verbose
695
    else {
696
        
697
        # Remove line and module infromation
698
        my $at_pos = rindex($error, ' at ');
699
        $error = substr($error, 0, $at_pos);
700
        $error =~ s/\s+$//;
701
        
702
        croak "$error$append";
703
    }
704
}
705

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
708
=head1 NAME
709

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

            
712
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
713

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
722
    # Insert 
723
    $dbi->insert(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
724
                 param  => {title => 'Perl', author => 'Ken'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
725
                 filter => {title => 'encode_utf8'});
726
    
727
    # Update 
728
    $dbi->update(table  => 'books', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
729
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
730
                 where  => {id => 5},
731
                 filter => {title => 'encode_utf8'});
732
    
733
    # Update all
734
    $dbi->update_all(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
735
                     param  => {title => 'Perl'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
736
                     filter => {title => 'encode_utf8'});
737
    
738
    # Delete
739
    $dbi->delete(table  => 'books',
740
                 where  => {author => 'Ken'},
741
                 filter => {title => 'encode_utf8'});
742
    
743
    # Delete all
744
    $dbi->delete_all(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
745

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
748
    # Select
749
    my $result = $dbi->select(table => 'books');
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
750
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
751
    # Select, more complex
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
752
    my $result = $dbi->select(
update document
yuki-kimoto authored on 2010-05-27
753
        table  => 'books',
754
        column => [qw/author title/],
755
        where  => {author => 'Ken'},
updated document
yuki-kimoto authored on 2010-08-08
756
        append => 'order by id limit 5',
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
757
        filter => {title => 'encode_utf8'}
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
758
    );
added commit method
yuki-kimoto authored on 2010-05-27
759
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
760
    # Select, join table
added commit method
yuki-kimoto authored on 2010-05-27
761
    my $result = $dbi->select(
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
762
        table    => ['books', 'rental'],
763
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
764
        relation => {'books.id' => 'rental.book_id'}
765
    );
updated document
yuki-kimoto authored on 2010-08-08
766
    
767
    # Select, more flexible where
768
    my $result = $dbi->select(
769
        table  => 'books',
770
        where  => ['{= author} and {like title}', 
771
                   {author => 'Ken', title => '%Perl%'}]
772
    );
cleanup
yuki-kimoto authored on 2010-08-05
773

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
776
    # Execute SQL
removed register_format()
yuki-kimoto authored on 2010-05-26
777
    $dbi->execute("select title from books");
778
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
779
    # Execute SQL with hash binding and filtering
updated document
yuki-kimoto authored on 2010-08-08
780
    $dbi->execute("select id from books where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
781
                  param  => {author => 'ken', title => '%Perl%'},
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
782
                  filter => {title => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
783

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

            
updated document
yuki-kimoto authored on 2010-08-08
790
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
791

            
792
    # Get DBI object
793
    my $dbh = $dbi->dbh;
794

            
795
Fetch row.
796

            
removed register_format()
yuki-kimoto authored on 2010-05-26
797
    # Fetch
798
    while (my $row = $result->fetch) {
799
        # ...
800
    }
801
    
802
    # Fetch hash
803
    while (my $row = $result->fetch_hash) {
804
        
805
    }
806
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
807
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
808

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
843
    $dbi          = $dbi->cache_method(\&cache_method);
844
    $cache_method = $dbi->cache_method
845

            
846
Method to set and get caches.
847

            
848
B<Example:>
849

            
850
    $dbi->cache_method(
851
        sub {
852
            my $self = shift;
853
            
854
            $self->{_cached} ||= {};
855
            
856
            if (@_ > 1) {
857
                $self->{_cached}{$_[0]} = $_[1] 
858
            }
859
            else {
860
                return $self->{_cached}{$_[0]}
861
            }
862
        }
863
    );
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
864

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

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

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

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

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
880
=head2 C<dbi_options>
881

            
882
    my $dbi_options = $dbi->dbi_options;
883
    $dbi            = $dbi->dbi_options($dbi_options);
884

            
885
DBI options.
886
C<connect()> method use this value to connect the database.
887

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
895
Filter functions.
896
"encode_utf8" and "decode_utf8" is registered by default.
897

            
898
=head2 C<filter_check>
899

            
900
    my $filter_check = $dbi->filter_check;
901
    $dbi             = $dbi->filter_check(0);
902

            
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
903
B<this attribute is now deprecated and has no mean
904
because check is always done>. 
cleanup
yuki-kimoto authored on 2010-10-17
905

            
906
=head2 C<password>
907

            
908
    my $password = $dbi->password;
909
    $dbi         = $dbi->password('lkj&le`@s');
910

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
933
    my $user = $dbi->user;
934
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
935

            
cleanup
yuki-kimoto authored on 2010-10-17
936
User name.
937
C<connect()> method use this value to connect the database.
938
    
939
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
940

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

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
944
=head2 C<(experimental) auto_filter >
945

            
946
    $dbi->auto_filter(
947
        $table,
948
        [$column1, $bind_filter1, $fetch_filter1],
949
        [$column2, $bind_filter2, $fetch_filter2],
950
        [...],
951
    );
952

            
953
C<auto_filter> is automatically filter for columns of table.
954
This have effect C<insert>, C<update>, C<delete>. C<select>
cleanup
Yuki Kimoto authored on 2010-12-21
955
and L<DBIx::Custom::Result> object. but this has'nt C<execute> method.
956

            
957
If you want to have effect <execute< method, use C<auto_filter_table>
958
arguments.
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
959

            
cleanup
Yuki Kimoto authored on 2010-12-21
960
    $result = $dbi->execute(
961
        "select * from table1 where {= key1} and {= key2};",
962
         param => {key1 => 1, key2 => 2},
963
         auto_filter_table => ['table1']
964
    );
965
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
966
B<Example:>
967

            
968
    $dbi->auto_filter('books', 'sale_date', 'to_date', 'date_to');
969

            
970
=head2 C<begin_work>
added check_filter attribute
yuki-kimoto authored on 2010-08-08
971

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

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

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

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
980
=head2 C<commit>
cleanup
yuki-kimoto authored on 2010-10-17
981

            
982
    $dbi->commit;
983

            
984
Commit transaction.
985
This is same as L<DBI>'s C<commit>.
986

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
997
=head2 C<create_query>
998
    
999
    my $query = $dbi->create_query(
1000
        "select * from books where {= author} and {like title};"
1001
    );
update document
yuki-kimoto authored on 2009-11-19
1002

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

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

            
cleanup
Yuki Kimoto authored on 2010-12-21
1010
=head2 C<(deprecated) default_bind_filter>
1011

            
1012
    $dbi = $dbi->default_bind_filter($fname);
1013

            
1014
Default filter when parameter binding is executed.
1015

            
1016
=head2 C<(deprecated) default_fetch_filter>
1017

            
1018
    $dbi = $dbi->default_fetch_filter($fname);
1019

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1032
    my $result = $dbi->execute(
1033
        "select * from books where {= author} and {like title}", 
1034
        param => {author => 'Ken', title => '%Perl%'}
1035
    );
1036
    
1037
    while (my $row = $result->fetch) {
1038
        my $author = $row->[0];
1039
        my $title  = $row->[1];
1040
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1041

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

            
1044
    my %expand = $dbi->expand($source);
1045

            
1046
The following hash
1047

            
1048
    {books => {title => 'Perl', author => 'Ken'}}
1049

            
1050
is expanded to
1051

            
1052
    ('books.title' => 'Perl', 'books.author' => 'Ken')
1053

            
1054
This is used in C<select()>
1055

            
1056

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

            
cleanup
yuki-kimoto authored on 2010-08-05
1060
    $dbi->delete(table  => $table,
1061
                 where  => \%where,
1062
                 append => $append,
1063
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1064

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1065
Execute delete statement.
1066
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
1067
C<table> is a table name.
1068
C<where> is where clause. this must be hash reference.
1069
C<append> is a string added at the end of the SQL statement.
1070
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
1071
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1072

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

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

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

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

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

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

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

            
1095
    $dbi->helper(
1096
        update_or_insert => sub {
1097
            my $self = shift;
1098
            # do something
1099
        },
1100
        find_or_create   => sub {
1101
            my $self = shift;
1102
            # do something
1103
        }
1104
    );
1105

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

            
1108
    $dbi->update_or_insert;
1109
    $dbi->find_or_create;
1110

            
cleanup
yuki-kimoto authored on 2010-10-17
1111
=head2 C<insert>
1112

            
1113
    $dbi->insert(table  => $table, 
1114
                 param  => \%param,
1115
                 append => $append,
1116
                 filter => \%filter);
1117

            
1118
Execute insert statement.
1119
C<insert> method have C<table>, C<param>, C<append>
1120
and C<filter> arguments.
1121
C<table> is a table name.
1122
C<param> is the pairs of column name value. this must be hash reference.
1123
C<append> is a string added at the end of the SQL statement.
1124
C<filter> is filters when parameter binding is executed.
1125
This is overwrites C<default_bind_filter>.
1126
Return value of C<insert()> is the count of affected rows.
1127

            
1128
B<Example:>
1129

            
1130
    $dbi->insert(table  => 'books', 
1131
                 param  => {title => 'Perl', author => 'Taro'},
1132
                 append => "some statement",
1133
                 filter => {title => 'encode_utf8'})
1134

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

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

            
1140
Create a new L<DBIx::Custom> object.
1141

            
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1142
=head2 C<(experimental) iterate_all_columns>
1143

            
1144
    $dbi->iterate_all_columns(
1145
        sub {
1146
            my ($table, $column, $column_info) = @_;
1147
            
1148
            # do something;
1149
        }
1150
    );
1151

            
1152
Iterate all columns of all tables. Argument is callback.
1153
You can do anything by callback.
1154

            
cleanup
yuki-kimoto authored on 2010-10-17
1155
=head2 C<register_filter>
1156

            
1157
    $dbi->register_filter(%filters);
1158
    $dbi->register_filter(\%filters);
1159
    
1160
Register filter. Registered filters is available in the following attributes
1161
or arguments.
1162

            
1163
=over 4
1164

            
1165
=item *
1166

            
1167
C<filter> argument of C<insert()>, C<update()>,
1168
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1169
methods
1170

            
1171
=item *
1172

            
1173
C<execute()> method
1174

            
1175
=item *
1176

            
1177
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1178

            
1179
=item *
1180

            
1181
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1182

            
1183
=back
1184

            
1185
B<Example:>
1186

            
1187
    $dbi->register_filter(
1188
        encode_utf8 => sub {
1189
            my $value = shift;
1190
            
1191
            require Encode;
1192
            
1193
            return Encode::encode('UTF-8', $value);
1194
        },
1195
        decode_utf8 => sub {
1196
            my $value = shift;
1197
            
1198
            require Encode;
1199
            
1200
            return Encode::decode('UTF-8', $value)
1201
        }
1202
    );
1203

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1204
=head2 C<rollback>
cleanup
yuki-kimoto authored on 2010-10-17
1205

            
1206
    $dbi->rollback;
1207

            
1208
Rollback transaction.
1209
This is same as L<DBI>'s C<rollback>.
1210

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1211
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1212
    
cleanup
yuki-kimoto authored on 2010-08-05
1213
    my $result = $dbi->select(table    => $table,
1214
                              column   => [@column],
1215
                              where    => \%where,
1216
                              append   => $append,
1217
                              relation => \%relation,
1218
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1219

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1220
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1221
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1222
C<relation> and C<filter> arguments.
1223
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1224
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1225
C<append> is a string added at the end of the SQL statement.
1226
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1227

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

            
added commit method
yuki-kimoto authored on 2010-05-27
1230
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1231
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1232
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1233
    # select * from books where title = ?;
1234
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1235
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1236
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1237
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1238
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1239
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1240
        where  => {id => 1},
1241
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1242
    );
1243
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1244
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1245
    # where books.id = rental.book_id;
1246
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1247
        table    => ['books', 'rental'],
1248
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1249
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1250
    );
1251

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

            
1255
    my $result = $dbi->select(
1256
        table  => 'books',
1257
        column => ['title', 'author'],
1258
        where  => ['{= title} or {like author}',
1259
                   {title => '%Perl%', author => 'Ken'}]
1260
    );
1261

            
1262
First element is a string. it contains tags,
1263
such as "{= title} or {like author}".
1264
Second element is paramters.
1265

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1268
    $dbi->update(table  => $table, 
1269
                 param  => \%params,
1270
                 where  => \%where,
1271
                 append => $append,
1272
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1273

            
cleanup
yuki-kimoto authored on 2010-10-17
1274
Execute update statement.
1275
C<update> method have C<table>, C<param>, C<where>, C<append>
1276
and C<filter> arguments.
1277
C<table> is a table name.
1278
C<param> is column-value pairs. this must be hash reference.
1279
C<where> is where clause. this must be hash reference.
1280
C<append> is a string added at the end of the SQL statement.
1281
C<filter> is filters when parameter binding is executed.
1282
This is overwrites C<default_bind_filter>.
1283
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1284

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1287
    $dbi->update(table  => 'books',
1288
                 param  => {title => 'Perl', author => 'Taro'},
1289
                 where  => {id => 5},
1290
                 append => "some statement",
1291
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1292

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1295
    $dbi->update_all(table  => $table, 
1296
                     param  => \%params,
1297
                     filter => \%filter,
1298
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1299

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

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

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

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

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

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

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

            
1319
C<< <kimoto.yuki at gmail.com> >>
1320

            
1321
L<http://github.com/yuki-kimoto/DBIx-Custom>
1322

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1323
=head1 AUTHOR
1324

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

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

            
1329
Copyright 2009 Yuki Kimoto, all rights reserved.
1330

            
1331
This program is free software; you can redistribute it and/or modify it
1332
under the same terms as Perl itself.
1333

            
1334
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1335

            
1336