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

            
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];
101
        croak qq{"$bind_filter" is not registered}
102
          unless $self->filters->{$bind_filter};
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
103
        $self->{_auto_bind_filter}{$table}{$column}
104
          = $self->filters->{$bind_filter};
105
        $self->{_auto_bind_filter}{$table}{"$table.$column"}
106
          = $self->filters->{$bind_filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
107
        
108
        # Fetch filter
109
        my $fetch_filter = $c->[2];
110
        croak qq{"$fetch_filter" is not registered}
111
          unless $self->filters->{$fetch_filter};
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
112
        $self->{_auto_fetch_filter}{$table}{$column}
113
          = $self->filters->{$fetch_filter};
114
        $self->{_auto_fetch_filter}{$table}{"$table.$column"}
115
          = $self->filters->{$fetch_filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
116
    }
117
    
118
    return $self;
119
}
120

            
added helper method
yuki-kimoto authored on 2010-10-17
121
sub helper {
122
    my $self = shift;
123
    
124
    # Merge
125
    my $helpers = ref $_[0] eq 'HASH' ? $_[0] : {@_};
126
    $self->{_helpers} = {%{$self->{_helpers} || {}}, %$helpers};
127
    
128
    return $self;
129
}
130

            
packaging one directory
yuki-kimoto authored on 2009-11-16
131
sub connect {
removed register_format()
yuki-kimoto authored on 2010-05-26
132
    my $proto = shift;
133
    
134
    # Create
135
    my $self = ref $proto ? $proto : $proto->new(@_);
update document
yuki-kimoto authored on 2010-01-30
136
    
137
    # Information
packaging one directory
yuki-kimoto authored on 2009-11-16
138
    my $data_source = $self->data_source;
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
139
    
140
    croak qq{"data_source" must be specfied to connect method"}
141
      unless $data_source;
142
    
packaging one directory
yuki-kimoto authored on 2009-11-16
143
    my $user        = $self->user;
144
    my $password    = $self->password;
added dbi_options attribute
kimoto authored on 2010-12-20
145
    my $dbi_options = $self->dbi_options || {};
146
    
update document
yuki-kimoto authored on 2010-01-30
147
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
148
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
149
        $data_source,
150
        $user,
151
        $password,
152
        {
153
            RaiseError => 1,
154
            PrintError => 0,
155
            AutoCommit => 1,
added dbi_options attribute
kimoto authored on 2010-12-20
156
            %$dbi_options
packaging one directory
yuki-kimoto authored on 2009-11-16
157
        }
158
    )};
159
    
update document
yuki-kimoto authored on 2010-01-30
160
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
161
    croak $@ if $@;
162
    
update document
yuki-kimoto authored on 2010-01-30
163
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
164
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
165
    
packaging one directory
yuki-kimoto authored on 2009-11-16
166
    return $self;
167
}
168

            
cleanup
yuki-kimoto authored on 2010-10-17
169
sub create_query {
170
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
171
    
cleanup
yuki-kimoto authored on 2010-10-17
172
    # Cache
173
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
174
    
cleanup
yuki-kimoto authored on 2010-10-17
175
    # Create query
176
    my $query;
177
    if ($cache) {
178
        
179
        # Get query
180
        my $q = $self->cache_method->($self, $source);
181
        
182
        # Create query
183
        $query = DBIx::Custom::Query->new($q) if $q;
184
    }
185
    
186
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
187

            
cleanup
yuki-kimoto authored on 2010-10-17
188
        # Create SQL object
189
        my $builder = $self->query_builder;
190
        
191
        # Create query
192
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
193

            
cleanup
yuki-kimoto authored on 2010-10-17
194
        # Cache query
195
        $self->cache_method->($self, $source,
196
                             {sql     => $query->sql, 
197
                              columns => $query->columns})
198
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
199
    }
200
    
cleanup
yuki-kimoto authored on 2010-10-17
201
    # Prepare statement handle
202
    my $sth;
203
    eval { $sth = $self->dbh->prepare($query->{sql})};
204
    $self->_croak($@, qq{. SQL: "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
205
    
cleanup
yuki-kimoto authored on 2010-10-17
206
    # Set statement handle
207
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
208
    
cleanup
yuki-kimoto authored on 2010-10-17
209
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
210
}
211

            
cleanup
yuki-kimoto authored on 2010-10-17
212
our %VALID_DELETE_ARGS
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
213
  = 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
214

            
cleanup
yuki-kimoto authored on 2010-10-17
215
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
216
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
217
    
218
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
219
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
220
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
221
          unless $VALID_DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
222
    }
223
    
224
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
225
    my $table            = $args{table} || '';
226
    my $where            = $args{where} || {};
cleanup
yuki-kimoto authored on 2010-10-17
227
    my $append = $args{append};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
228
    my $filter           = $args{filter};
cleanup
yuki-kimoto authored on 2010-10-17
229
    my $allow_delete_all = $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
230

            
231
    my $auto_filter_table = exists $args{auto_filter_table}
232
                          ? $args{auto_filter_table}
233
                          : [$table];
234
    $auto_filter_table ||= [];    
235

            
packaging one directory
yuki-kimoto authored on 2009-11-16
236
    # Where keys
removed register_format()
yuki-kimoto authored on 2010-05-26
237
    my @where_keys = keys %$where;
packaging one directory
yuki-kimoto authored on 2009-11-16
238
    
239
    # Not exists where keys
add tests
yuki-kimoto authored on 2010-08-10
240
    croak qq{"where" argument must be specified and } .
241
          qq{contains the pairs of column name and value}
cleanup
yuki-kimoto authored on 2010-10-17
242
      if !@where_keys && !$allow_delete_all;
packaging one directory
yuki-kimoto authored on 2009-11-16
243
    
244
    # Where clause
245
    my $where_clause = '';
246
    if (@where_keys) {
247
        $where_clause = 'where ';
add tests
yuki-kimoto authored on 2010-08-10
248
        $where_clause .= "{= $_} and " for @where_keys;
packaging one directory
yuki-kimoto authored on 2009-11-16
249
        $where_clause =~ s/ and $//;
250
    }
251
    
add tests
yuki-kimoto authored on 2010-08-10
252
    # Source of SQL
cleanup
yuki-kimoto authored on 2010-10-17
253
    my $source = "delete from $table $where_clause";
add tests
yuki-kimoto authored on 2010-08-10
254
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
255
    
256
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
257
    my $ret_val = $self->execute(
258
        $source, param  => $where, filter => $filter,
259
        auto_filter_table => $auto_filter_table);
packaging one directory
yuki-kimoto authored on 2009-11-16
260
    
261
    return $ret_val;
262
}
263

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

            
added helper method
yuki-kimoto authored on 2010-10-17
266
sub DESTROY { }
267

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

            
cleanup
yuki-kimoto authored on 2010-10-17
270
sub execute{
271
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
272
    
273
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
274
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
275
        croak qq{"$name" is invalid argument}
cleanup
yuki-kimoto authored on 2010-10-17
276
          unless $VALID_EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
277
    }
278
    
cleanup
yuki-kimoto authored on 2010-10-17
279
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
280
    
cleanup
yuki-kimoto authored on 2010-10-17
281
    # First argument is the soruce of SQL
282
    $query = $self->create_query($query)
283
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
284
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
285
    # Auto filter
286
    my $auto_filter = {};
287
    my $auto_filter_tables = $args{auto_filter_table} || [];
288
    foreach my $table (@$auto_filter_tables) {
289
        $auto_filter = {
290
            %$auto_filter,
291
            %{$self->{_auto_bind_filter}->{$table} || {}}
292
        }
293
    }
294
    
295
    # Filter
cleanup
yuki-kimoto authored on 2010-10-17
296
    my $filter = $args{filter} || $query->filter || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
297
    $filter = {%$auto_filter, %$filter};
packaging one directory
yuki-kimoto authored on 2009-11-16
298
    
cleanup
yuki-kimoto authored on 2010-10-17
299
    # Create bind value
300
    my $bind_values = $self->_build_bind_values($query, $params, $filter);
301
    
302
    # Execute
303
    my $sth      = $query->sth;
304
    my $affected;
305
    eval {$affected = $sth->execute(@$bind_values)};
306
    $self->_croak($@) if $@;
307
    
308
    # Return resultset if select statement is executed
309
    if ($sth->{NUM_OF_FIELDS}) {
310
        
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
311
        # Auto fetch filter
312
        my $auto_fetch_filter = {};
313
	    foreach my $table (@$auto_filter_tables) {
314
	        $auto_fetch_filter = {
315
	            %$auto_filter,
316
	            %{$self->{_auto_fetch_filter}{$table} || {}}
317
	        }
318
	    }
319
	    
320
		# Result
321
		my $result = $self->result_class->new(
cleanup
yuki-kimoto authored on 2010-10-17
322
            sth            => $sth,
323
            default_filter => $self->default_fetch_filter,
324
            filters        => $self->filters,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
325
            filter_check   => $self->filter_check,
326
            _auto_filter   => $auto_fetch_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
327
        );
328

            
329
        return $result;
330
    }
331
    return $affected;
332
}
333

            
added experimental expand me...
yuki-kimoto authored on 2010-10-20
334
sub expand {
335
    my $self = shift;
336
    my $source = ref $_[0] eq 'HASH' ? $_[0] : {@_};
337
    my $table = (keys %$source)[0];
338
    my $param = $source->{$table};
339
    
340
    # Expand table name
341
    my $expand = {};
342
    foreach my $column (keys %$param) {
343
        $expand->{"$table.$column"} = $param->{$column};
344
    }
345
    
346
    return %$expand;
347
}
348

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

            
354
    # Check arguments
355
    foreach my $name (keys %args) {
356
        croak qq{"$name" is invalid argument}
357
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
358
    }
359
    
cleanup
yuki-kimoto authored on 2010-10-17
360
    # Arguments
361
    my $table  = $args{table} || '';
362
    my $param  = $args{param} || {};
363
    my $append = $args{append} || '';
364
    my $filter = $args{filter};
365
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
366
    my $auto_filter_table = exists $args{auto_filter_table}
367
                          ? $args{auto_filter_table}
368
                          : [$table];
369
    $auto_filter_table ||= [];
370
    
cleanup
yuki-kimoto authored on 2010-10-17
371
    # Insert keys
372
    my @insert_keys = keys %$param;
373
    
374
    # Templte for insert
375
    my $source = "insert into $table {insert_param "
376
               . join(' ', @insert_keys) . '}';
add tests
yuki-kimoto authored on 2010-08-10
377
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
378
    
379
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
380
    my $ret_val = $self->execute(
381
        $source,
382
        param  => $param,
383
        filter => $filter,
384
        auto_filter_table => $auto_filter_table
385
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
386
    
387
    return $ret_val;
388
}
389

            
added dbi_options attribute
kimoto authored on 2010-12-20
390
sub new {
391
    my $self = shift->SUPER::new(@_);
392
    
393
    # Check attribute names
394
    my @attrs = keys %$self;
395
    foreach my $attr (@attrs) {
396
        croak qq{"$attr" is invalid attribute name}
397
          unless $self->can($attr);
398
    }
399
    
400
    return $self;
401
}
402

            
cleanup
yuki-kimoto authored on 2010-10-17
403
sub register_filter {
404
    my $invocant = shift;
405
    
406
    # Register filter
407
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
408
    $invocant->filters({%{$invocant->filters}, %$filters});
409
    
410
    return $invocant;
411
}
packaging one directory
yuki-kimoto authored on 2009-11-16
412

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
416
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
417
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
418
    
refactoring select
yuki-kimoto authored on 2010-04-28
419
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
420
    foreach my $name (keys %args) {
add tests
yuki-kimoto authored on 2010-08-10
421
        croak qq{"$name" is invalid argument}
refactoring select
yuki-kimoto authored on 2010-04-28
422
          unless $VALID_SELECT_ARGS{$name};
423
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
424
    
refactoring select
yuki-kimoto authored on 2010-04-28
425
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
426
    my $tables = $args{table} || [];
removed register_format()
yuki-kimoto authored on 2010-05-26
427
    $tables = [$tables] unless ref $tables eq 'ARRAY';
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
428
    my $columns  = $args{column} || [];
update document
yuki-kimoto authored on 2010-08-07
429
    my $where    = $args{where};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
430
    my $relation = $args{relation};
431
    my $append   = $args{append};
432
    my $filter   = $args{filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
433

            
434
    my $auto_filter_table = exists $args{auto_filter_table}
435
                          ? $args{auto_filter_table}
436
                          : $tables;
packaging one directory
yuki-kimoto authored on 2009-11-16
437
    
add tests
yuki-kimoto authored on 2010-08-10
438
    # Source of SQL
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
439
    my $source = 'select ';
packaging one directory
yuki-kimoto authored on 2009-11-16
440
    
added commit method
yuki-kimoto authored on 2010-05-27
441
    # Column clause
packaging one directory
yuki-kimoto authored on 2009-11-16
442
    if (@$columns) {
443
        foreach my $column (@$columns) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
444
            $source .= "$column, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
445
        }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
446
        $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
447
    }
448
    else {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
449
        $source .= '* ';
packaging one directory
yuki-kimoto authored on 2009-11-16
450
    }
451
    
added commit method
yuki-kimoto authored on 2010-05-27
452
    # Table
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
453
    $source .= 'from ';
packaging one directory
yuki-kimoto authored on 2009-11-16
454
    foreach my $table (@$tables) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
455
        $source .= "$table, ";
packaging one directory
yuki-kimoto authored on 2009-11-16
456
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
457
    $source =~ s/, $/ /;
packaging one directory
yuki-kimoto authored on 2009-11-16
458
    
added commit method
yuki-kimoto authored on 2010-05-27
459
    # Where clause
update document
yuki-kimoto authored on 2010-08-07
460
    my $param;
461
    if (ref $where eq 'HASH') {
462
        $param = $where;
463
        $source .= 'where (';
464
        foreach my $where_key (keys %$where) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
465
            $source .= "{= $where_key} and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
466
        }
update document
yuki-kimoto authored on 2010-08-07
467
        $source =~ s/ and $//;
468
        $source .= ') ';
469
    }
470
    elsif (ref $where eq 'ARRAY') {
471
        my$where_str = $where->[0] || '';
472
        $param = $where->[1];
473
        
474
        $source .= "where ($where_str) ";
packaging one directory
yuki-kimoto authored on 2009-11-16
475
    }
476
    
added commit method
yuki-kimoto authored on 2010-05-27
477
    # Relation
478
    if ($relation) {
update document
yuki-kimoto authored on 2010-08-07
479
        $source .= $where ? "and " : "where ";
added commit method
yuki-kimoto authored on 2010-05-27
480
        foreach my $rkey (keys %$relation) {
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
481
            $source .= "$rkey = " . $relation->{$rkey} . " and ";
packaging one directory
yuki-kimoto authored on 2009-11-16
482
        }
483
    }
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
484
    $source =~ s/ and $//;
added commit method
yuki-kimoto authored on 2010-05-27
485
    
486
    # Append some statement
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
487
    $source .= " $append" if $append;
packaging one directory
yuki-kimoto authored on 2009-11-16
488
    
489
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
490
    my $result = $self->execute(
491
        $source, param  => $param, filter => $filter,
492
        auto_filter_table => $auto_filter_table);    
packaging one directory
yuki-kimoto authored on 2009-11-16
493
    
494
    return $result;
495
}
496

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

            
501
sub update {
502
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
503
    
cleanup
yuki-kimoto authored on 2010-10-17
504
    # Check arguments
505
    foreach my $name (keys %args) {
506
        croak qq{"$name" is invalid argument}
507
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
508
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
509
    
cleanup
yuki-kimoto authored on 2010-10-17
510
    # Arguments
511
    my $table            = $args{table} || '';
512
    my $param            = $args{param} || {};
513
    my $where            = $args{where} || {};
514
    my $append = $args{append} || '';
515
    my $filter           = $args{filter};
516
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
517
    
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
518
    my $auto_filter_table = exists $args{auto_filter_table}
519
                          ? $args{auto_filter_table}
520
                          : [$table];
521
    $auto_filter_table ||= [];
522
    
cleanup
yuki-kimoto authored on 2010-10-17
523
    # Update keys
524
    my @update_keys = keys %$param;
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
525
    
cleanup
yuki-kimoto authored on 2010-10-17
526
    # Where keys
527
    my @where_keys = keys %$where;
removed reconnect method
yuki-kimoto authored on 2010-05-28
528
    
cleanup
yuki-kimoto authored on 2010-10-17
529
    # Not exists where keys
530
    croak qq{"where" argument must be specified and } .
531
          qq{contains the pairs of column name and value}
532
      if !@where_keys && !$allow_update_all;
removed experimental registe...
yuki-kimoto authored on 2010-08-24
533
    
cleanup
yuki-kimoto authored on 2010-10-17
534
    # Update clause
535
    my $update_clause = '{update_param ' . join(' ', @update_keys) . '}';
removed experimental registe...
yuki-kimoto authored on 2010-08-24
536
    
cleanup
yuki-kimoto authored on 2010-10-17
537
    # Where clause
538
    my $where_clause = '';
539
    my $new_where = {};
removed reconnect method
yuki-kimoto authored on 2010-05-28
540
    
cleanup
yuki-kimoto authored on 2010-10-17
541
    if (@where_keys) {
542
        $where_clause = 'where ';
543
        $where_clause .= "{= $_} and " for @where_keys;
544
        $where_clause =~ s/ and $//;
removed reconnect method
yuki-kimoto authored on 2010-05-28
545
    }
546
    
cleanup
yuki-kimoto authored on 2010-10-17
547
    # Source of SQL
548
    my $source = "update $table $update_clause $where_clause";
549
    $source .= " $append" if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
550
    
cleanup
yuki-kimoto authored on 2010-10-17
551
    # Rearrange parameters
552
    foreach my $wkey (@where_keys) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
553
        
cleanup
yuki-kimoto authored on 2010-10-17
554
        if (exists $param->{$wkey}) {
555
            $param->{$wkey} = [$param->{$wkey}]
556
              unless ref $param->{$wkey} eq 'ARRAY';
557
            
558
            push @{$param->{$wkey}}, $where->{$wkey};
559
        }
560
        else {
561
            $param->{$wkey} = $where->{$wkey};
562
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
563
    }
cleanup
yuki-kimoto authored on 2010-10-17
564
    
565
    # Execute query
566
    my $ret_val = $self->execute($source, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
567
                                 filter => $filter,
568
                                 auto_filter_table => $auto_filter_table);
cleanup
yuki-kimoto authored on 2010-10-17
569
    
570
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
571
}
572

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
575
sub _build_bind_values {
576
    my ($self, $query, $params, $filter) = @_;
577
    
578
    # binding values
579
    my @bind_values;
add tests
yuki-kimoto authored on 2010-08-08
580

            
581
    # Filter
582
    $filter ||= {};
583
    
584
    # Parameter
585
    $params ||= {};
586
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
587
    # Build bind values
588
    my $count = {};
589
    foreach my $column (@{$query->columns}) {
590
        
591
        # Value
592
        my $value = ref $params->{$column} eq 'ARRAY'
593
                  ? $params->{$column}->[$count->{$column} || 0]
594
                  : $params->{$column};
595
        
add tests
yuki-kimoto authored on 2010-08-10
596
        # Filtering
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
597
        my $fname = $filter->{$column} || $self->default_bind_filter || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
598
        my $filter_func = ref $fname ? $fname
599
                        : $fname ? $self->filters->{$fname}
600
                        : undef;
601
        
removed reconnect method
yuki-kimoto authored on 2010-05-28
602
        push @bind_values, $filter_func
603
                         ? $filter_func->($value)
604
                         : $value;
605
        
606
        # Count up 
607
        $count->{$column}++;
608
    }
609
    
610
    return \@bind_values;
611
}
612

            
cleanup
yuki-kimoto authored on 2010-10-17
613
sub _croak {
614
    my ($self, $error, $append) = @_;
615
    $append ||= "";
616
    
617
    # Verbose
618
    if ($Carp::Verbose) { croak $error }
619
    
620
    # Not verbose
621
    else {
622
        
623
        # Remove line and module infromation
624
        my $at_pos = rindex($error, ' at ');
625
        $error = substr($error, 0, $at_pos);
626
        $error =~ s/\s+$//;
627
        
628
        croak "$error$append";
629
    }
630
}
631

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
634
=head1 NAME
635

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

            
638
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
639

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
648
    # Insert 
649
    $dbi->insert(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
650
                 param  => {title => 'Perl', author => 'Ken'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
651
                 filter => {title => 'encode_utf8'});
652
    
653
    # Update 
654
    $dbi->update(table  => 'books', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
655
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
656
                 where  => {id => 5},
657
                 filter => {title => 'encode_utf8'});
658
    
659
    # Update all
660
    $dbi->update_all(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
661
                     param  => {title => 'Perl'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
662
                     filter => {title => 'encode_utf8'});
663
    
664
    # Delete
665
    $dbi->delete(table  => 'books',
666
                 where  => {author => 'Ken'},
667
                 filter => {title => 'encode_utf8'});
668
    
669
    # Delete all
670
    $dbi->delete_all(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
671

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
674
    # Select
675
    my $result = $dbi->select(table => 'books');
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
676
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
677
    # Select, more complex
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
678
    my $result = $dbi->select(
update document
yuki-kimoto authored on 2010-05-27
679
        table  => 'books',
680
        column => [qw/author title/],
681
        where  => {author => 'Ken'},
updated document
yuki-kimoto authored on 2010-08-08
682
        append => 'order by id limit 5',
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
683
        filter => {title => 'encode_utf8'}
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
684
    );
added commit method
yuki-kimoto authored on 2010-05-27
685
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
686
    # Select, join table
added commit method
yuki-kimoto authored on 2010-05-27
687
    my $result = $dbi->select(
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
688
        table    => ['books', 'rental'],
689
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
690
        relation => {'books.id' => 'rental.book_id'}
691
    );
updated document
yuki-kimoto authored on 2010-08-08
692
    
693
    # Select, more flexible where
694
    my $result = $dbi->select(
695
        table  => 'books',
696
        where  => ['{= author} and {like title}', 
697
                   {author => 'Ken', title => '%Perl%'}]
698
    );
cleanup
yuki-kimoto authored on 2010-08-05
699

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
702
    # Execute SQL
removed register_format()
yuki-kimoto authored on 2010-05-26
703
    $dbi->execute("select title from books");
704
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
705
    # Execute SQL with hash binding and filtering
updated document
yuki-kimoto authored on 2010-08-08
706
    $dbi->execute("select id from books where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
707
                  param  => {author => 'ken', title => '%Perl%'},
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
708
                  filter => {title => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
709

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

            
updated document
yuki-kimoto authored on 2010-08-08
716
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
717

            
removed register_format()
yuki-kimoto authored on 2010-05-26
718
    # Default filter
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
719
    $dbi->default_bind_filter('encode_utf8');
removed register_format()
yuki-kimoto authored on 2010-05-26
720
    $dbi->default_fetch_filter('decode_utf8');
cleanup
yuki-kimoto authored on 2010-08-05
721

            
722
    # Get DBI object
723
    my $dbh = $dbi->dbh;
724

            
725
Fetch row.
726

            
removed register_format()
yuki-kimoto authored on 2010-05-26
727
    # Fetch
728
    while (my $row = $result->fetch) {
729
        # ...
730
    }
731
    
732
    # Fetch hash
733
    while (my $row = $result->fetch_hash) {
734
        
735
    }
736
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
737
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
738

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
773
    $dbi          = $dbi->cache_method(\&cache_method);
774
    $cache_method = $dbi->cache_method
775

            
776
Method to set and get caches.
777

            
778
B<Example:>
779

            
780
    $dbi->cache_method(
781
        sub {
782
            my $self = shift;
783
            
784
            $self->{_cached} ||= {};
785
            
786
            if (@_ > 1) {
787
                $self->{_cached}{$_[0]} = $_[1] 
788
            }
789
            else {
790
                return $self->{_cached}{$_[0]}
791
            }
792
        }
793
    );
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
794

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

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

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

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

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
810
=head2 C<dbi_options>
811

            
812
    my $dbi_options = $dbi->dbi_options;
813
    $dbi            = $dbi->dbi_options($dbi_options);
814

            
815
DBI options.
816
C<connect()> method use this value to connect the database.
817

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
837
Filter functions.
838
"encode_utf8" and "decode_utf8" is registered by default.
839

            
840
=head2 C<filter_check>
841

            
842
    my $filter_check = $dbi->filter_check;
843
    $dbi             = $dbi->filter_check(0);
844

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

            
848
=head2 C<password>
849

            
850
    my $password = $dbi->password;
851
    $dbi         = $dbi->password('lkj&le`@s');
852

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
875
    my $user = $dbi->user;
876
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
877

            
cleanup
yuki-kimoto authored on 2010-10-17
878
User name.
879
C<connect()> method use this value to connect the database.
880
    
881
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
882

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

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

            
888
    $dbi->auto_filter(
889
        $table,
890
        [$column1, $bind_filter1, $fetch_filter1],
891
        [$column2, $bind_filter2, $fetch_filter2],
892
        [...],
893
    );
894

            
895
C<auto_filter> is automatically filter for columns of table.
896
This have effect C<insert>, C<update>, C<delete>. C<select>
897
and L<DBIx::Custom::Result> object.
898

            
899
B<Example:>
900

            
901
    $dbi->auto_filter('books', 'sale_date', 'to_date', 'date_to');
902

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

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

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

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

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

            
915
    $dbi->commit;
916

            
917
Commit transaction.
918
This is same as L<DBI>'s C<commit>.
919

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
930
=head2 C<create_query>
931
    
932
    my $query = $dbi->create_query(
933
        "select * from books where {= author} and {like title};"
934
    );
update document
yuki-kimoto authored on 2009-11-19
935

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
955
    my $result = $dbi->execute(
956
        "select * from books where {= author} and {like title}", 
957
        param => {author => 'Ken', title => '%Perl%'}
958
    );
959
    
960
    while (my $row = $result->fetch) {
961
        my $author = $row->[0];
962
        my $title  = $row->[1];
963
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
964

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

            
967
    my %expand = $dbi->expand($source);
968

            
969
The following hash
970

            
971
    {books => {title => 'Perl', author => 'Ken'}}
972

            
973
is expanded to
974

            
975
    ('books.title' => 'Perl', 'books.author' => 'Ken')
976

            
977
This is used in C<select()>
978

            
979

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

            
cleanup
yuki-kimoto authored on 2010-08-05
983
    $dbi->delete(table  => $table,
984
                 where  => \%where,
985
                 append => $append,
986
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
987

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
988
Execute delete statement.
989
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
990
C<table> is a table name.
991
C<where> is where clause. this must be hash reference.
992
C<append> is a string added at the end of the SQL statement.
993
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
994
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
995

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

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

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

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

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

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

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

            
1018
    $dbi->helper(
1019
        update_or_insert => sub {
1020
            my $self = shift;
1021
            # do something
1022
        },
1023
        find_or_create   => sub {
1024
            my $self = shift;
1025
            # do something
1026
        }
1027
    );
1028

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

            
1031
    $dbi->update_or_insert;
1032
    $dbi->find_or_create;
1033

            
cleanup
yuki-kimoto authored on 2010-10-17
1034
=head2 C<insert>
1035

            
1036
    $dbi->insert(table  => $table, 
1037
                 param  => \%param,
1038
                 append => $append,
1039
                 filter => \%filter);
1040

            
1041
Execute insert statement.
1042
C<insert> method have C<table>, C<param>, C<append>
1043
and C<filter> arguments.
1044
C<table> is a table name.
1045
C<param> is the pairs of column name value. this must be hash reference.
1046
C<append> is a string added at the end of the SQL statement.
1047
C<filter> is filters when parameter binding is executed.
1048
This is overwrites C<default_bind_filter>.
1049
Return value of C<insert()> is the count of affected rows.
1050

            
1051
B<Example:>
1052

            
1053
    $dbi->insert(table  => 'books', 
1054
                 param  => {title => 'Perl', author => 'Taro'},
1055
                 append => "some statement",
1056
                 filter => {title => 'encode_utf8'})
1057

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

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

            
1063
Create a new L<DBIx::Custom> object.
1064

            
cleanup
yuki-kimoto authored on 2010-10-17
1065
=head2 C<register_filter>
1066

            
1067
    $dbi->register_filter(%filters);
1068
    $dbi->register_filter(\%filters);
1069
    
1070
Register filter. Registered filters is available in the following attributes
1071
or arguments.
1072

            
1073
=over 4
1074

            
1075
=item *
1076

            
1077
C<default_bind_filter>, C<default_fetch_filter>
1078

            
1079
=item *
1080

            
1081
C<filter> argument of C<insert()>, C<update()>,
1082
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1083
methods
1084

            
1085
=item *
1086

            
1087
C<execute()> method
1088

            
1089
=item *
1090

            
1091
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1092

            
1093
=item *
1094

            
1095
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1096

            
1097
=back
1098

            
1099
B<Example:>
1100

            
1101
    $dbi->register_filter(
1102
        encode_utf8 => sub {
1103
            my $value = shift;
1104
            
1105
            require Encode;
1106
            
1107
            return Encode::encode('UTF-8', $value);
1108
        },
1109
        decode_utf8 => sub {
1110
            my $value = shift;
1111
            
1112
            require Encode;
1113
            
1114
            return Encode::decode('UTF-8', $value)
1115
        }
1116
    );
1117

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

            
1120
    $dbi->rollback;
1121

            
1122
Rollback transaction.
1123
This is same as L<DBI>'s C<rollback>.
1124

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1125
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1126
    
cleanup
yuki-kimoto authored on 2010-08-05
1127
    my $result = $dbi->select(table    => $table,
1128
                              column   => [@column],
1129
                              where    => \%where,
1130
                              append   => $append,
1131
                              relation => \%relation,
1132
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1133

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1134
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1135
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1136
C<relation> and C<filter> arguments.
1137
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1138
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1139
C<append> is a string added at the end of the SQL statement.
1140
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1141

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

            
added commit method
yuki-kimoto authored on 2010-05-27
1144
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1145
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1146
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1147
    # select * from books where title = ?;
1148
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1149
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1150
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1151
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1152
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1153
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1154
        where  => {id => 1},
1155
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1156
    );
1157
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1158
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1159
    # where books.id = rental.book_id;
1160
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1161
        table    => ['books', 'rental'],
1162
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1163
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1164
    );
1165

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

            
1169
    my $result = $dbi->select(
1170
        table  => 'books',
1171
        column => ['title', 'author'],
1172
        where  => ['{= title} or {like author}',
1173
                   {title => '%Perl%', author => 'Ken'}]
1174
    );
1175

            
1176
First element is a string. it contains tags,
1177
such as "{= title} or {like author}".
1178
Second element is paramters.
1179

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1182
    $dbi->update(table  => $table, 
1183
                 param  => \%params,
1184
                 where  => \%where,
1185
                 append => $append,
1186
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1187

            
cleanup
yuki-kimoto authored on 2010-10-17
1188
Execute update statement.
1189
C<update> method have C<table>, C<param>, C<where>, C<append>
1190
and C<filter> arguments.
1191
C<table> is a table name.
1192
C<param> is column-value pairs. this must be hash reference.
1193
C<where> is where clause. this must be hash reference.
1194
C<append> is a string added at the end of the SQL statement.
1195
C<filter> is filters when parameter binding is executed.
1196
This is overwrites C<default_bind_filter>.
1197
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1198

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1201
    $dbi->update(table  => 'books',
1202
                 param  => {title => 'Perl', author => 'Taro'},
1203
                 where  => {id => 5},
1204
                 append => "some statement",
1205
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1206

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1209
    $dbi->update_all(table  => $table, 
1210
                     param  => \%params,
1211
                     filter => \%filter,
1212
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1213

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

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

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

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

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

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

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

            
1233
C<< <kimoto.yuki at gmail.com> >>
1234

            
1235
L<http://github.com/yuki-kimoto/DBIx-Custom>
1236

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1237
=head1 AUTHOR
1238

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

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

            
1243
Copyright 2009 Yuki Kimoto, all rights reserved.
1244

            
1245
This program is free software; you can redistribute it and/or modify it
1246
under the same terms as Perl itself.
1247

            
1248
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1249

            
1250