DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
1264 lines | 32.722kb
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};
103
        $self->{_auto_bind_filter}{$table}{$column} = $bind_filter;
104
        $self->{_auto_bind_filter}{$table}{"$table.$column"} = $bind_filter;
105
        
106
        # Fetch filter
107
        my $fetch_filter = $c->[2];
108
        croak qq{"$fetch_filter" is not registered}
109
          unless $self->filters->{$fetch_filter};
110
        $self->{_auto_fetch_filter}{$table}{$column} = $fetch_filter;
111
        $self->{_auto_fetch_filter}{$table}{"$table.$column"} = $fetch_filter;
112
    }
113
    
114
    return $self;
115
}
116

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

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

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

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

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

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

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

            
227
    my $auto_filter_table = exists $args{auto_filter_table}
228
                          ? $args{auto_filter_table}
229
                          : [$table];
230
    $auto_filter_table ||= [];    
231

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
262
sub DESTROY { }
263

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

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

            
325
        return $result;
326
    }
327
    return $affected;
328
}
329

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

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

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

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

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

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

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

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

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

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

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

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

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

            
add tests
yuki-kimoto authored on 2010-08-08
611
sub _check_filter {
612
    my ($self, $filters, $filter, $default_filter, $params) = @_;
613
    
614
    # Filter name not exists
615
    foreach my $fname (values %$filter) {
616
        croak qq{Bind filter "$fname" is not registered}
617
          unless exists $filters->{$fname};
618
    }
619
    
620
    # Default filter name not exists
621
    croak qq{Default bind filter "$default_filter" is not registered}
622
      if $default_filter && ! exists $filters->{$default_filter};
623
}
624

            
cleanup
yuki-kimoto authored on 2010-10-17
625
sub _croak {
626
    my ($self, $error, $append) = @_;
627
    $append ||= "";
628
    
629
    # Verbose
630
    if ($Carp::Verbose) { croak $error }
631
    
632
    # Not verbose
633
    else {
634
        
635
        # Remove line and module infromation
636
        my $at_pos = rindex($error, ' at ');
637
        $error = substr($error, 0, $at_pos);
638
        $error =~ s/\s+$//;
639
        
640
        croak "$error$append";
641
    }
642
}
643

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
646
=head1 NAME
647

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

            
650
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
651

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
660
    # Insert 
661
    $dbi->insert(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
662
                 param  => {title => 'Perl', author => 'Ken'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
663
                 filter => {title => 'encode_utf8'});
664
    
665
    # Update 
666
    $dbi->update(table  => 'books', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
667
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
668
                 where  => {id => 5},
669
                 filter => {title => 'encode_utf8'});
670
    
671
    # Update all
672
    $dbi->update_all(table  => 'books',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
673
                     param  => {title => 'Perl'},
removed reconnect method
yuki-kimoto authored on 2010-05-28
674
                     filter => {title => 'encode_utf8'});
675
    
676
    # Delete
677
    $dbi->delete(table  => 'books',
678
                 where  => {author => 'Ken'},
679
                 filter => {title => 'encode_utf8'});
680
    
681
    # Delete all
682
    $dbi->delete_all(table => 'books');
cleanup
yuki-kimoto authored on 2010-08-05
683

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
686
    # Select
687
    my $result = $dbi->select(table => 'books');
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
688
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
689
    # Select, more complex
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
690
    my $result = $dbi->select(
update document
yuki-kimoto authored on 2010-05-27
691
        table  => 'books',
692
        column => [qw/author title/],
693
        where  => {author => 'Ken'},
updated document
yuki-kimoto authored on 2010-08-08
694
        append => 'order by id limit 5',
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
695
        filter => {title => 'encode_utf8'}
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
696
    );
added commit method
yuki-kimoto authored on 2010-05-27
697
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
698
    # Select, join table
added commit method
yuki-kimoto authored on 2010-05-27
699
    my $result = $dbi->select(
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
700
        table    => ['books', 'rental'],
701
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
702
        relation => {'books.id' => 'rental.book_id'}
703
    );
updated document
yuki-kimoto authored on 2010-08-08
704
    
705
    # Select, more flexible where
706
    my $result = $dbi->select(
707
        table  => 'books',
708
        where  => ['{= author} and {like title}', 
709
                   {author => 'Ken', title => '%Perl%'}]
710
    );
cleanup
yuki-kimoto authored on 2010-08-05
711

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
714
    # Execute SQL
removed register_format()
yuki-kimoto authored on 2010-05-26
715
    $dbi->execute("select title from books");
716
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
717
    # Execute SQL with hash binding and filtering
updated document
yuki-kimoto authored on 2010-08-08
718
    $dbi->execute("select id from books where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
719
                  param  => {author => 'ken', title => '%Perl%'},
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
720
                  filter => {title => 'encode_utf8'});
removed reconnect method
yuki-kimoto authored on 2010-05-28
721

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

            
updated document
yuki-kimoto authored on 2010-08-08
728
Other features.
cleanup
yuki-kimoto authored on 2010-08-05
729

            
removed register_format()
yuki-kimoto authored on 2010-05-26
730
    # Default filter
renamed default_query_filter...
yuki-kimoto authored on 2010-08-03
731
    $dbi->default_bind_filter('encode_utf8');
removed register_format()
yuki-kimoto authored on 2010-05-26
732
    $dbi->default_fetch_filter('decode_utf8');
cleanup
yuki-kimoto authored on 2010-08-05
733

            
734
    # Get DBI object
735
    my $dbh = $dbi->dbh;
736

            
737
Fetch row.
738

            
removed register_format()
yuki-kimoto authored on 2010-05-26
739
    # Fetch
740
    while (my $row = $result->fetch) {
741
        # ...
742
    }
743
    
744
    # Fetch hash
745
    while (my $row = $result->fetch_hash) {
746
        
747
    }
748
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
749
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
750

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
785
    $dbi          = $dbi->cache_method(\&cache_method);
786
    $cache_method = $dbi->cache_method
787

            
788
Method to set and get caches.
789

            
790
B<Example:>
791

            
792
    $dbi->cache_method(
793
        sub {
794
            my $self = shift;
795
            
796
            $self->{_cached} ||= {};
797
            
798
            if (@_ > 1) {
799
                $self->{_cached}{$_[0]} = $_[1] 
800
            }
801
            else {
802
                return $self->{_cached}{$_[0]}
803
            }
804
        }
805
    );
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
806

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

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

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

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

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
822
=head2 C<dbi_options>
823

            
824
    my $dbi_options = $dbi->dbi_options;
825
    $dbi            = $dbi->dbi_options($dbi_options);
826

            
827
DBI options.
828
C<connect()> method use this value to connect the database.
829

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
849
Filter functions.
850
"encode_utf8" and "decode_utf8" is registered by default.
851

            
852
=head2 C<filter_check>
853

            
854
    my $filter_check = $dbi->filter_check;
855
    $dbi             = $dbi->filter_check(0);
856

            
857
Enable filter check. 
858
Default to 1.
859
This check maybe damege performance.
860
If you require performance, set C<filter_check> attribute to 0.
861

            
862
=head2 C<password>
863

            
864
    my $password = $dbi->password;
865
    $dbi         = $dbi->password('lkj&le`@s');
866

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
889
    my $user = $dbi->user;
890
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
891

            
cleanup
yuki-kimoto authored on 2010-10-17
892
User name.
893
C<connect()> method use this value to connect the database.
894
    
895
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
896

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

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

            
902
    $dbi->auto_filter(
903
        $table,
904
        [$column1, $bind_filter1, $fetch_filter1],
905
        [$column2, $bind_filter2, $fetch_filter2],
906
        [...],
907
    );
908

            
909
C<auto_filter> is automatically filter for columns of table.
910
This have effect C<insert>, C<update>, C<delete>. C<select>
911
and L<DBIx::Custom::Result> object.
912

            
913
B<Example:>
914

            
915
    $dbi->auto_filter('books', 'sale_date', 'to_date', 'date_to');
916

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

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

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

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

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

            
929
    $dbi->commit;
930

            
931
Commit transaction.
932
This is same as L<DBI>'s C<commit>.
933

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
944
=head2 C<create_query>
945
    
946
    my $query = $dbi->create_query(
947
        "select * from books where {= author} and {like title};"
948
    );
update document
yuki-kimoto authored on 2009-11-19
949

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
969
    my $result = $dbi->execute(
970
        "select * from books where {= author} and {like title}", 
971
        param => {author => 'Ken', title => '%Perl%'}
972
    );
973
    
974
    while (my $row = $result->fetch) {
975
        my $author = $row->[0];
976
        my $title  = $row->[1];
977
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
978

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

            
981
    my %expand = $dbi->expand($source);
982

            
983
The following hash
984

            
985
    {books => {title => 'Perl', author => 'Ken'}}
986

            
987
is expanded to
988

            
989
    ('books.title' => 'Perl', 'books.author' => 'Ken')
990

            
991
This is used in C<select()>
992

            
993

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

            
cleanup
yuki-kimoto authored on 2010-08-05
997
    $dbi->delete(table  => $table,
998
                 where  => \%where,
999
                 append => $append,
1000
                 filter => \%filter);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1001

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1002
Execute delete statement.
1003
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
1004
C<table> is a table name.
1005
C<where> is where clause. this must be hash reference.
1006
C<append> is a string added at the end of the SQL statement.
1007
C<filter> is filters when parameter binding is executed.
cleanup
yuki-kimoto authored on 2010-08-09
1008
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1009

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

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

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

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

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

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

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

            
1032
    $dbi->helper(
1033
        update_or_insert => sub {
1034
            my $self = shift;
1035
            # do something
1036
        },
1037
        find_or_create   => sub {
1038
            my $self = shift;
1039
            # do something
1040
        }
1041
    );
1042

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

            
1045
    $dbi->update_or_insert;
1046
    $dbi->find_or_create;
1047

            
cleanup
yuki-kimoto authored on 2010-10-17
1048
=head2 C<insert>
1049

            
1050
    $dbi->insert(table  => $table, 
1051
                 param  => \%param,
1052
                 append => $append,
1053
                 filter => \%filter);
1054

            
1055
Execute insert statement.
1056
C<insert> method have C<table>, C<param>, C<append>
1057
and C<filter> arguments.
1058
C<table> is a table name.
1059
C<param> is the pairs of column name value. this must be hash reference.
1060
C<append> is a string added at the end of the SQL statement.
1061
C<filter> is filters when parameter binding is executed.
1062
This is overwrites C<default_bind_filter>.
1063
Return value of C<insert()> is the count of affected rows.
1064

            
1065
B<Example:>
1066

            
1067
    $dbi->insert(table  => 'books', 
1068
                 param  => {title => 'Perl', author => 'Taro'},
1069
                 append => "some statement",
1070
                 filter => {title => 'encode_utf8'})
1071

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

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

            
1077
Create a new L<DBIx::Custom> object.
1078

            
cleanup
yuki-kimoto authored on 2010-10-17
1079
=head2 C<register_filter>
1080

            
1081
    $dbi->register_filter(%filters);
1082
    $dbi->register_filter(\%filters);
1083
    
1084
Register filter. Registered filters is available in the following attributes
1085
or arguments.
1086

            
1087
=over 4
1088

            
1089
=item *
1090

            
1091
C<default_bind_filter>, C<default_fetch_filter>
1092

            
1093
=item *
1094

            
1095
C<filter> argument of C<insert()>, C<update()>,
1096
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1097
methods
1098

            
1099
=item *
1100

            
1101
C<execute()> method
1102

            
1103
=item *
1104

            
1105
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1106

            
1107
=item *
1108

            
1109
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1110

            
1111
=back
1112

            
1113
B<Example:>
1114

            
1115
    $dbi->register_filter(
1116
        encode_utf8 => sub {
1117
            my $value = shift;
1118
            
1119
            require Encode;
1120
            
1121
            return Encode::encode('UTF-8', $value);
1122
        },
1123
        decode_utf8 => sub {
1124
            my $value = shift;
1125
            
1126
            require Encode;
1127
            
1128
            return Encode::decode('UTF-8', $value)
1129
        }
1130
    );
1131

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

            
1134
    $dbi->rollback;
1135

            
1136
Rollback transaction.
1137
This is same as L<DBI>'s C<rollback>.
1138

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1139
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1140
    
cleanup
yuki-kimoto authored on 2010-08-05
1141
    my $result = $dbi->select(table    => $table,
1142
                              column   => [@column],
1143
                              where    => \%where,
1144
                              append   => $append,
1145
                              relation => \%relation,
1146
                              filter   => \%filter);
update document
yuki-kimoto authored on 2009-11-19
1147

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1148
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1149
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1150
C<relation> and C<filter> arguments.
1151
C<table> is a table name.
cleanup
yuki-kimoto authored on 2010-08-09
1152
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1153
C<append> is a string added at the end of the SQL statement.
1154
C<filter> is filters when parameter binding is executed.
update document
yuki-kimoto authored on 2009-11-19
1155

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

            
added commit method
yuki-kimoto authored on 2010-05-27
1158
    # select * from books;
cleanup
yuki-kimoto authored on 2010-08-05
1159
    my $result = $dbi->select(table => 'books');
packaging one directory
yuki-kimoto authored on 2009-11-16
1160
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1161
    # select * from books where title = ?;
1162
    my $result = $dbi->select(table => 'books', where => {title => 'Perl'});
update document
yuki-kimoto authored on 2009-11-19
1163
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1164
    # select title, author from books where id = ? for update;
cleanup
yuki-kimoto authored on 2010-08-05
1165
    my $result = $dbi->select(
removed register_format()
yuki-kimoto authored on 2010-05-26
1166
        table  => 'books',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1167
        column => ['title', 'author'],
removed register_format()
yuki-kimoto authored on 2010-05-26
1168
        where  => {id => 1},
1169
        appned => 'for update'
update document
yuki-kimoto authored on 2009-11-19
1170
    );
1171
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1172
    # select books.name as book_name from books, rental
added commit method
yuki-kimoto authored on 2010-05-27
1173
    # where books.id = rental.book_id;
1174
    my $result = $dbi->select(
removed reconnect method
yuki-kimoto authored on 2010-05-28
1175
        table    => ['books', 'rental'],
1176
        column   => ['books.name as book_name']
added commit method
yuki-kimoto authored on 2010-05-27
1177
        relation => {'books.id' => 'rental.book_id'}
update document
yuki-kimoto authored on 2009-11-19
1178
    );
1179

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

            
1183
    my $result = $dbi->select(
1184
        table  => 'books',
1185
        column => ['title', 'author'],
1186
        where  => ['{= title} or {like author}',
1187
                   {title => '%Perl%', author => 'Ken'}]
1188
    );
1189

            
1190
First element is a string. it contains tags,
1191
such as "{= title} or {like author}".
1192
Second element is paramters.
1193

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1196
    $dbi->update(table  => $table, 
1197
                 param  => \%params,
1198
                 where  => \%where,
1199
                 append => $append,
1200
                 filter => \%filter)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1201

            
cleanup
yuki-kimoto authored on 2010-10-17
1202
Execute update statement.
1203
C<update> method have C<table>, C<param>, C<where>, C<append>
1204
and C<filter> arguments.
1205
C<table> is a table name.
1206
C<param> is column-value pairs. this must be hash reference.
1207
C<where> is where clause. this must be hash reference.
1208
C<append> is a string added at the end of the SQL statement.
1209
C<filter> is filters when parameter binding is executed.
1210
This is overwrites C<default_bind_filter>.
1211
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1212

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1215
    $dbi->update(table  => 'books',
1216
                 param  => {title => 'Perl', author => 'Taro'},
1217
                 where  => {id => 5},
1218
                 append => "some statement",
1219
                 filter => {title => 'encode_utf8'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1220

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1223
    $dbi->update_all(table  => $table, 
1224
                     param  => \%params,
1225
                     filter => \%filter,
1226
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1227

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

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

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

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

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

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

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

            
1247
C<< <kimoto.yuki at gmail.com> >>
1248

            
1249
L<http://github.com/yuki-kimoto/DBIx-Custom>
1250

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1251
=head1 AUTHOR
1252

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

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

            
1257
Copyright 2009 Yuki Kimoto, all rights reserved.
1258

            
1259
This program is free software; you can redistribute it and/or modify it
1260
under the same terms as Perl itself.
1261

            
1262
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1263

            
1264