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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
3
our $VERSION = '0.1665';
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;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
19
use DBIx::Custom::Util;
update document
yuki-kimoto authored on 2010-05-27
20
use Encode qw/encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
21

            
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
22
our @COMMON_ARGS = qw/table query filter type/;
cleanup
Yuki Kimoto authored on 2011-03-21
23

            
fix tests
Yuki Kimoto authored on 2011-01-13
24
__PACKAGE__->attr(
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
25
    [qw/data_source password pid user/],
fix tests
Yuki Kimoto authored on 2011-01-13
26
    cache => 1,
many changed
Yuki Kimoto authored on 2011-01-23
27
    cache_method => sub {
28
        sub {
29
            my $self = shift;
30
            
31
            $self->{_cached} ||= {};
32
            
33
            if (@_ > 1) {
update pod
Yuki Kimoto authored on 2011-03-13
34
                $self->{_cached}{$_[0]} = $_[1];
many changed
Yuki Kimoto authored on 2011-01-23
35
            }
36
            else {
update pod
Yuki Kimoto authored on 2011-03-13
37
                return $self->{_cached}{$_[0]};
many changed
Yuki Kimoto authored on 2011-01-23
38
            }
39
        }
update pod
Yuki Kimoto authored on 2011-03-13
40
    },
41
    dbi_option => sub { {} },
42
    default_dbi_option => sub {
43
        {
44
            RaiseError => 1,
45
            PrintError => 0,
46
            AutoCommit => 1
47
        }
48
    },
fix tests
Yuki Kimoto authored on 2011-01-13
49
    filters => sub {
50
        {
51
            encode_utf8 => sub { encode_utf8($_[0]) },
52
            decode_utf8 => sub { decode_utf8($_[0]) }
53
        }
update pod
Yuki Kimoto authored on 2011-03-13
54
    },
55
    models => sub { {} },
56
    query_builder => sub { DBIx::Custom::QueryBuilder->new },
57
    result_class  => 'DBIx::Custom::Result',
58
    safety_character => '\w',
59
    stash => sub { {} }
fix tests
Yuki Kimoto authored on 2011-01-13
60
);
cleanup
yuki-kimoto authored on 2010-10-17
61

            
added helper method
yuki-kimoto authored on 2010-10-17
62
our $AUTOLOAD;
63
sub AUTOLOAD {
64
    my $self = shift;
65

            
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
66
    # Method name
67
    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
added helper method
yuki-kimoto authored on 2010-10-17
68

            
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
69
    # Method
70
    $self->{_methods} ||= {};
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
71
    if (my $method = $self->{_methods}->{$mname}) {
72
        return $self->$method(@_)
73
    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
74
    elsif (my $dbh_method = $self->dbh->can($mname)) {
75
        $self->dbh->$dbh_method(@_);
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
76
    }
77
    else {
78
        croak qq/Can't locate object method "$mname" via "$package"/
79
    }
added helper method
yuki-kimoto authored on 2010-10-17
80
}
81

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
82
sub apply_filter {
many changed
Yuki Kimoto authored on 2011-01-23
83
    my ($self, $table, @cinfos) = @_;
84

            
85
    # Initialize filters
cleanup
Yuki Kimoto authored on 2011-01-12
86
    $self->{filter} ||= {};
many changed
Yuki Kimoto authored on 2011-01-23
87
    $self->{filter}{out} ||= {};
88
    $self->{filter}{in} ||= {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
89
    $self->{filter}{end} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-22
90
    
many changed
Yuki Kimoto authored on 2011-01-23
91
    # Create filters
92
    my $usage = "Usage: \$dbi->apply_filter(" .
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
93
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
94
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
many changed
Yuki Kimoto authored on 2011-01-23
95

            
96
    for (my $i = 0; $i < @cinfos; $i += 2) {
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
97
        
many changed
Yuki Kimoto authored on 2011-01-23
98
        # Column
99
        my $column = $cinfos[$i];
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
100
        
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
101
        if (ref $column eq 'ARRAY') {
102
            foreach my $c (@$column) {
103
                push @cinfos, $c, $cinfos[$i + 1];
104
            }
105
            next;
106
        }
107
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
108
        # Filter info
109
        my $finfo = $cinfos[$i + 1] || {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
110
        croak "$usage (table: $table)" unless  ref $finfo eq 'HASH';
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
111
        foreach my $ftype (keys %$finfo) {
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
112
            croak "$usage (table: $table 2)" unless $ftype eq 'in' || $ftype eq 'out'
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
113
                             || $ftype eq 'end'; 
many changed
Yuki Kimoto authored on 2011-01-23
114
        }
115
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
116
        foreach my $way (qw/in out end/) {
117
            my $filter = $finfo->{$way};
cleanup
Yuki Kimoto authored on 2010-12-22
118
            
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
119
            # State
120
            my $state = !exists $finfo->{$way} ? 'not_exists'
121
                      : !defined $filter        ? 'not_defined'
122
                      : ref $filter eq 'CODE'   ? 'code'
123
                      : 'name';
124
            
125
            next if $state eq 'not_exists';
126
            
127
            # Check filter
128
            croak qq{Filter "$filter" is not registered}
129
              if  $state eq 'name'
130
               && ! exists $self->filters->{$filter};
131
            
132
            # Filter
133
            my $f = $state eq 'not_defined' ? undef
134
                  : $state eq 'code'        ? $filter
135
                  : $self->filters->{$filter};
136
            $self->{filter}{$way}{$table}{$column} = $f;
137
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
138
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
139
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
140
    }
141
    
many changed
Yuki Kimoto authored on 2011-01-23
142
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
143
}
144

            
cleanup
Yuki Kimoto authored on 2011-03-21
145
sub column {
146
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
147
    
cleanup
Yuki Kimoto authored on 2011-03-21
148
    $columns ||= [];
added helper method
yuki-kimoto authored on 2010-10-17
149
    
cleanup
Yuki Kimoto authored on 2011-03-21
150
    my @column;
151
    push @column, "$table.$_ as ${table}__$_" for @$columns;
152
    
153
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
154
}
155

            
packaging one directory
yuki-kimoto authored on 2009-11-16
156
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
157
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
158
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
159
    my $dbh = $self->_connect;
packaging one directory
yuki-kimoto authored on 2009-11-16
160
    
update document
yuki-kimoto authored on 2010-01-30
161
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
162
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
163
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
164
    # Process ID
165
    $self->pid($$);
166
    
packaging one directory
yuki-kimoto authored on 2009-11-16
167
    return $self;
168
}
169

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
198
        # Cache query
199
        $self->cache_method->($self, $source,
200
                             {sql     => $query->sql, 
add table tag
Yuki Kimoto authored on 2011-02-09
201
                              columns => $query->columns,
202
                              tables  => $query->tables})
cleanup
yuki-kimoto authored on 2010-10-17
203
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
204
    }
205
    
cleanup
yuki-kimoto authored on 2010-10-17
206
    # Prepare statement handle
207
    my $sth;
208
    eval { $sth = $self->dbh->prepare($query->{sql})};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
209
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
210
    
cleanup
yuki-kimoto authored on 2010-10-17
211
    # Set statement handle
212
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
213
    
cleanup
Yuki Kimoto authored on 2011-02-09
214
    # Set filters
215
    $query->filters($self->filters);
216
    
cleanup
yuki-kimoto authored on 2010-10-17
217
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
218
}
219

            
update pod
Yuki Kimoto authored on 2011-03-13
220
sub dbh {
221
    my $self = shift;
222

            
223
    if (@_) {
224
        $self->{dbh} = $_[0];
225
        return $self;
226
    }
227
    else {
228
        my $pid = $$;
229
        if ($self->pid eq $pid) {
230
            return $self->{dbh};
231
        }
232
        else {
233
            # Create new connection in child process
234
            croak "Process is forked in transaction"
235
              unless $self->{dbh}->{AutoCommit};
236
            $self->pid($pid);
237
            $self->{dbh}->{InactiveDestroy} = 1;
238
            return $self->{dbh} = $self->_connect;
239
        }
240
    }
241
}
242

            
cleanup
Yuki Kimoto authored on 2011-03-21
243
our %DELETE_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
244
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
245

            
cleanup
yuki-kimoto authored on 2010-10-17
246
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
247
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
248
    
cleanup
Yuki Kimoto authored on 2011-03-09
249
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
250
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
251
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
252
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
253
    }
254
    
255
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
256
    my $table = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
257
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
258
    my $where            = delete $args{where} || {};
259
    my $append           = delete $args{append};
260
    my $allow_delete_all = delete $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
261

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
262
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
263
    my $w = $self->_where($where);
264
    $where = $w->param;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
265
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
266
    # String where
267
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
268
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
269
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
270
      if $swhere eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
271

            
cleanup
Yuki Kimoto authored on 2011-01-27
272
    # SQL stack
273
    my @sql;
274

            
275
    # Delete
276
    push @sql, "delete from $table $swhere";
277
    push @sql, $append if $append;
278
    
279
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
280
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
281
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
282
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
283
    return $query if $args{query};
284
    
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
286
    my $ret_val = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
287
        $query,
288
        param  => $where,
289
        table => $table,
290
        %args
291
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
292
    
293
    return $ret_val;
294
}
295

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
298
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
299

            
300
sub delete_at {
301
    my ($self, %args) = @_;
302
    
cleanup
Yuki Kimoto authored on 2011-03-09
303
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
304
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
305
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
306
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
307
    }
308
    
309
    # Primary key
310
    my $primary_keys = delete $args{primary_key};
311
    $primary_keys = [$primary_keys] unless ref $primary_keys;
312
    
313
    # Where clause
314
    my $where = {};
315
    if (exists $args{where}) {
316
        my $where_columns = delete $args{where};
317
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
318

            
319
        croak qq{"where" must be constant value or array reference}
320
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
321
        
322
        for(my $i = 0; $i < @$primary_keys; $i ++) {
323
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
324
        }
325
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
326
    
327
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
328
        my $param = delete $args{param};
329
        
330
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
331
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
332
        }
333
    }
334
    
335
    return $self->delete(where => $where, %args);
336
}
337

            
added helper method
yuki-kimoto authored on 2010-10-17
338
sub DESTROY { }
339

            
cleanup
Yuki Kimoto authored on 2011-03-21
340
our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
341

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
342
sub create_model {
343
    my $self = shift;
344
    
345
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
346
    $args->{dbi} = $self;
347
    
348
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
349
    my $model_name  = delete $args->{name};
350
    my $model_table = delete $args->{table};
351
    $model_name ||= $model_table;
352
    
353
    my $model = $model_class->new($args);
354
    $model->name($model_name) unless $model->name;
355
    $model->table($model_table) unless $model->table;
356
    
357
    # Apply filter
358
    croak "$model_class filter must be array reference"
359
      unless ref $model->filter eq 'ARRAY';
360
    $self->apply_filter($model->table, @{$model->filter});
361
    
362
    # Table - Model
363
    croak "Table name is duplicated"
364
      if exists $self->{_model_from}->{$model->table};
365
    $self->{_model_from}->{$model->table} = $model->name;
366

            
367
    # Table alias
368
    $self->{_table_alias} ||= {};
369
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
370
    
371
    # Set model
372
    $self->model($model->name, $model);
373
    
374
    return $self;
375
}
376

            
377
sub each_column {
378
    my ($self, $cb) = @_;
379
    
380
    # Iterate all tables
381
    my $sth_tables = $self->dbh->table_info;
382
    while (my $table_info = $sth_tables->fetchrow_hashref) {
383
        
384
        # Table
385
        my $table = $table_info->{TABLE_NAME};
386
        
387
        # Iterate all columns
388
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
389
        while (my $column_info = $sth_columns->fetchrow_hashref) {
390
            my $column = $column_info->{COLUMN_NAME};
391
            $self->$cb($table, $column, $column_info);
392
        }
393
    }
394
}
395

            
cleanup
yuki-kimoto authored on 2010-10-17
396
sub execute{
397
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
398
    
cleanup
Yuki Kimoto authored on 2011-03-09
399
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
400
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
401
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
402
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
403
    }
404
    
cleanup
yuki-kimoto authored on 2010-10-17
405
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
406
    
cleanup
yuki-kimoto authored on 2010-10-17
407
    # First argument is the soruce of SQL
408
    $query = $self->create_query($query)
409
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
410
    
add table tag
Yuki Kimoto authored on 2011-02-09
411
    # Applied filter
cleanup
Yuki Kimoto authored on 2011-01-12
412
    my $filter = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
413
    
add table tag
Yuki Kimoto authored on 2011-02-09
414
    my $tables = $query->tables;
415
    my $arg_tables = $args{table} || [];
416
    $arg_tables = [$arg_tables]
417
      unless ref $arg_tables eq 'ARRAY';
418
    push @$tables, @$arg_tables;
cleanup
Yuki Kimoto authored on 2011-03-09
419

            
420
    # Organize tables
421
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
422
    my $main_table = pop @$tables;
423
    delete $table_set{$main_table} if $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
424
    foreach my $table (keys %table_set) {
425
        push @$tables, $table;
426
        
427
        if (my $dist = $self->{_table_alias}->{$table}) {
428
            $self->{filter} ||= {};
429
            
430
            unless ($self->{filter}{out}{$table}) {
431
                $self->{filter}{out} ||= {};
432
                $self->{filter}{in}  ||= {};
433
                $self->{filter}{end} ||= {};
434
                
435
                foreach my $type (qw/out in end/) {
436
                    
437
                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {
438
                        my $filter_name_alias = $filter_name;
439
                        $filter_name_alias =~ s/^$dist\./$table\./;
440
                        $filter_name_alias =~ s/^${dist}__/${table}__/; 
441
                        
442
                        $self->{filter}{$type}{$table}{$filter_name_alias}
443
                          = $self->{filter}{$type}{$dist}{$filter_name}
444
                    }
445
                }
446
            }
447
        }
448
    }
449
    
cleanup
Yuki Kimoto authored on 2011-03-09
450
    $tables = [keys %table_set];
451
    push @$tables, $main_table if $main_table;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
452
    
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
453
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
454
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
455
        $filter = {
456
            %$filter,
457
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
458
        }
459
    }
460
    
cleanup
Yuki Kimoto authored on 2011-01-12
461
    # Filter argument
cleanup
Yuki Kimoto authored on 2011-03-21
462
    my $f = DBIx::Custom::Util::array_to_hash($args{filter})
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
463
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
464
    foreach my $column (keys %$f) {
465
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
466
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
467
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
468
        }
469
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
470
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
471
            unless exists $self->filters->{$fname};
472
          
cleanup
Yuki Kimoto authored on 2011-01-12
473
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
474
        }
475
    }
cleanup
Yuki Kimoto authored on 2011-01-12
476
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
477
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
478
    # Type
479
    my $type = DBIx::Custom::Util::array_to_hash($args{type});
480
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
481
    # Bind
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
482
    my $bind = $self->_bind($params, $query->columns, $filter, $type);
cleanup
yuki-kimoto authored on 2010-10-17
483
    
484
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
485
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
486
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
487
    eval {
488
        for (my $i = 0; $i < @$bind; $i++) {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
489
            if (my $type = $bind->[$i]->{type}) {
490
                $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);
491
            }
492
            else {
493
                $sth->bind_param($i + 1, $bind->[$i]->{value});
494
            }
cleanup
Yuki Kimoto authored on 2011-03-21
495
        }
496
        $affected = $sth->execute;
497
    };
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
498
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
499
    
500
    # Return resultset if select statement is executed
501
    if ($sth->{NUM_OF_FIELDS}) {
502
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
503
        # Result in and end filter
504
        my $in_filter  = {};
505
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
506
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
507
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
508
            $in_filter = {
509
                %$in_filter,
510
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
511
            };
512
            $end_filter = {
513
                %$end_filter,
514
                %{$self->{filter}{end}{$table} || {}}
515
            };
cleanup
Yuki Kimoto authored on 2011-01-12
516
        }
517
        
518
        # Result
519
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
520
            sth            => $sth,
521
            filters        => $self->filters,
522
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
523
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
524
            filter         => $in_filter || {},
525
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
526
        );
527

            
528
        return $result;
529
    }
530
    return $affected;
531
}
532

            
cleanup
Yuki Kimoto authored on 2011-03-21
533
our %INSERT_ARGS = map { $_ => 1 } @COMMON_ARGS, qw/param append/;
update pod
Yuki Kimoto authored on 2011-03-13
534

            
cleanup
yuki-kimoto authored on 2010-10-17
535
sub insert {
536
    my ($self, %args) = @_;
537

            
cleanup
Yuki Kimoto authored on 2011-03-09
538
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
539
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
540
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
541
          unless $INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
542
    }
543
    
cleanup
yuki-kimoto authored on 2010-10-17
544
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
545
    my $table  = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
546
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
547
    my $param  = delete $args{param} || {};
548
    my $append = delete $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
549
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
550
    # Columns
551
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
552
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
553
    foreach my $column (keys %$param) {
554
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
555
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
556
        push @columns, $column;
557
    }
cleanup
yuki-kimoto authored on 2010-10-17
558
    
cleanup
Yuki Kimoto authored on 2011-01-27
559
    # SQL stack
560
    my @sql;
561
    
562
    # Insert
563
    push @sql, "insert into $table {insert_param ". join(' ', @columns) . '}';
564
    push @sql, $append if $append;
565
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
566
    # SQL
cleanup
Yuki Kimoto authored on 2011-01-27
567
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
568
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
569
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
570
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
571
    return $query if $args{query};
572
    
packaging one directory
yuki-kimoto authored on 2009-11-16
573
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
574
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
575
        $query,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
576
        param  => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
577
        table => $table,
578
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
579
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
580
    
581
    return $ret_val;
582
}
583

            
cleanup
Yuki Kimoto authored on 2011-03-21
584
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
585

            
586
sub insert_at {
587
    my ($self, %args) = @_;
588
    
cleanup
Yuki Kimoto authored on 2011-03-09
589
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
590
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
591
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
592
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
593
    }
594
    
595
    # Primary key
596
    my $primary_keys = delete $args{primary_key};
597
    $primary_keys = [$primary_keys] unless ref $primary_keys;
598
    
599
    # Where clause
600
    my $where = {};
601
    my $param = {};
602
    
603
    if (exists $args{where}) {
604
        my $where_columns = delete $args{where};
605
        $where_columns = [$where_columns] unless ref $where_columns;
606

            
607
        croak qq{"where" must be constant value or array reference}
608
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
609
        
610
        for(my $i = 0; $i < @$primary_keys; $i ++) {
611
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
612
        }
613
    }
614
    
615
    if (exists $args{param}) {
616
        $param = delete $args{param};
617
        for(my $i = 0; $i < @$primary_keys; $i ++) {
618
             delete $param->{$primary_keys->[$i]};
619
        }
620
    }
621
    
622
    $param = {%$param, %$where};
623
    
624
    return $self->insert(param => $param, %args);
625
}
626

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
627
sub insert_param {
628
    my ($self, $param) = @_;
629
    
update pod
Yuki Kimoto authored on 2011-03-13
630
    # Insert parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
631
    my @tag;
632
    push @tag, '{insert_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
633
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
634
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
635
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
636
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
637
        push @tag, $column;
638
    }
639
    push @tag, '}';
640
    
641
    return join ' ', @tag;
642
}
643

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
644
sub include_model {
645
    my ($self, $name_space, $model_infos) = @_;
646
    
647
    $name_space ||= '';
648
    unless ($model_infos) {
649
        # Load name space module
650
        croak qq{"$name_space" is invalid class name}
651
          if $name_space =~ /[^\w:]/;
652
        eval "use $name_space";
653
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
654
        
655
        # Search model modules
656
        my $path = $INC{"$name_space.pm"};
657
        $path =~ s/\.pm$//;
658
        opendir my $dh, $path
659
          or croak qq{Can't open directory "$path": $!};
660
        $model_infos = [];
661
        while (my $module = readdir $dh) {
662
            push @$model_infos, $module
663
              if $module =~ s/\.pm$//;
664
        }
665
        
666
        close $dh;
667
    }
668
    
669
    foreach my $model_info (@$model_infos) {
670
        
671
        # Model class, name, table
672
        my $model_class;
673
        my $model_name;
674
        my $model_table;
675
        if (ref $model_info eq 'HASH') {
676
            $model_class = $model_info->{class};
677
            $model_name  = $model_info->{name};
678
            $model_table = $model_info->{table};
679
            
680
            $model_name  ||= $model_class;
681
            $model_table ||= $model_name;
682
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
683
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
684
        my $mclass = "${name_space}::$model_class";
685
        
686
        # Load
687
        croak qq{"$mclass" is invalid class name}
688
          if $mclass =~ /[^\w:]/;
689
        unless ($mclass->can('isa')) {
690
            eval "use $mclass";
691
            croak $@ if $@;
692
        }
693
        
694
        # Instantiate
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
695
        my $args = {};
696
        $args->{model_class} = $mclass if $mclass;
697
        $args->{name}        = $model_name if $model_name;
698
        $args->{table}       = $model_table if $model_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
699
        
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
700
        # Create model
701
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
702
    }
703
    
704
    return $self;
705
}
706

            
cleanup
Yuki Kimoto authored on 2011-03-21
707
sub method {
708
    my $self = shift;
709
    
710
    # Merge
711
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
712
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
713
    
714
    return $self;
715
}
716

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
717
sub model {
718
    my ($self, $name, $model) = @_;
719
    
720
    # Set
721
    if ($model) {
722
        $self->models->{$name} = $model;
723
        return $self;
724
    }
725
    
726
    # Check model existance
727
    croak qq{Model "$name" is not included}
728
      unless $self->models->{$name};
729
    
730
    # Get
731
    return $self->models->{$name};
732
}
733

            
cleanup
Yuki Kimoto authored on 2011-03-21
734
sub mycolumn {
735
    my ($self, $table, $columns) = @_;
736
    
737
    $columns ||= [];
738
    my @column;
739
    push @column, "$table.$_ as $_" for @$columns;
740
    
741
    return join (', ', @column);
742
}
743

            
added dbi_options attribute
kimoto authored on 2010-12-20
744
sub new {
745
    my $self = shift->SUPER::new(@_);
746
    
747
    # Check attribute names
748
    my @attrs = keys %$self;
749
    foreach my $attr (@attrs) {
750
        croak qq{"$attr" is invalid attribute name}
751
          unless $self->can($attr);
752
    }
cleanup
Yuki Kimoto authored on 2011-01-25
753

            
754
    $self->register_tag(
755
        '?'     => \&DBIx::Custom::Tag::placeholder,
756
        '='     => \&DBIx::Custom::Tag::equal,
757
        '<>'    => \&DBIx::Custom::Tag::not_equal,
758
        '>'     => \&DBIx::Custom::Tag::greater_than,
759
        '<'     => \&DBIx::Custom::Tag::lower_than,
760
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
761
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
762
        'like'  => \&DBIx::Custom::Tag::like,
763
        'in'    => \&DBIx::Custom::Tag::in,
764
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
765
        'update_param' => \&DBIx::Custom::Tag::update_param
766
    );
added dbi_options attribute
kimoto authored on 2010-12-20
767
    
768
    return $self;
769
}
770

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
771
sub not_exists { bless {}, 'DBIx::Custom::NotExists' }
772

            
cleanup
yuki-kimoto authored on 2010-10-17
773
sub register_filter {
774
    my $invocant = shift;
775
    
776
    # Register filter
777
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
778
    $invocant->filters({%{$invocant->filters}, %$filters});
779
    
780
    return $invocant;
781
}
packaging one directory
yuki-kimoto authored on 2009-11-16
782

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
783
sub register_tag { shift->query_builder->register_tag(@_) }
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
784

            
cleanup
Yuki Kimoto authored on 2011-03-21
785
our %SELECT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
786
  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation
787
                                     selection join/;
refactoring select
yuki-kimoto authored on 2010-04-28
788

            
packaging one directory
yuki-kimoto authored on 2009-11-16
789
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
790
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
791
    
cleanup
Yuki Kimoto authored on 2011-03-09
792
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
793
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
794
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
795
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
796
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
797
    
refactoring select
yuki-kimoto authored on 2010-04-28
798
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
799
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
800
    my $tables = ref $table eq 'ARRAY' ? $table
801
               : defined $table ? [$table]
802
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
803
    my $columns   = delete $args{column};
804
    my $selection = delete $args{selection} || '';
805
    my $where     = delete $args{where} || {};
806
    my $append    = delete $args{append};
807
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
808
    croak qq{"join" must be array reference}
809
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
810
    my $relation = delete $args{relation};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
811
    
cleanup
Yuki Kimoto authored on 2011-03-09
812
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
813
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
814
    
cleanup
Yuki Kimoto authored on 2011-01-27
815
    # SQL stack
816
    my @sql;
817
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
818
    
cleanup
Yuki Kimoto authored on 2011-03-09
819
    # Selection
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
820
    if ($selection) { 
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
821
        push @sql, $selection;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
822
        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {
823
             unshift @$tables, $1;
824
        }
825
        unshift @$tables, @{$self->_tables($selection)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
826
    }
cleanup
Yuki Kimoto authored on 2011-03-09
827
    
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
828
    # Column clause
829
    elsif ($columns) {
830

            
831
        $columns = [$columns] if ! ref $columns;
832
        
833
        if (ref $columns eq 'HASH') {
834
            # Find tables
835
            my $main_table;
836
            my %tables;
837
            if ($columns->{table}) {
838
                foreach my $table (@{$columns->{table}}) {
839
                    if (($table || '') eq $tables->[-1]) {
840
                        $main_table = $table;
841
                    }
842
                    else {
843
                        $tables{$table} = 1;
844
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
845
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
846
            }
847
            elsif ($columns->{all}) {
848
                $main_table = $tables->[-1] || '';
849
                foreach my $j (@$join) {
850
                    my $tables = $self->_tables($j);
851
                    foreach my $table (@$tables) {
852
                        $tables{$table} = 1;
853
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
854
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
855
                delete $tables{$main_table};
856
            }
857
            
858
            push @sql, $columns->{prepend} if $columns->{prepend};
859
            
860
            # Column clause of main table
861
            if ($main_table) {
cleanup
Yuki Kimoto authored on 2011-03-21
862
                push @sql, $self->model($main_table)->mycolumn;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
863
                push @sql, ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
864
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
865
            
866
            # Column cluase of other tables
867
            foreach my $table (keys %tables) {
868
                unshift @$tables, $table;
cleanup
Yuki Kimoto authored on 2011-03-21
869
                push @sql, $self->model($table)->column($table);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
870
                push @sql, ',';
871
            }
872
            pop @sql if $sql[-1] eq ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
873
        }
874
        else {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
875
            foreach my $column (@$columns) {
876
                unshift @$tables, @{$self->_tables($column)};
877
                push @sql, ($column, ',');
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
878
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
879
            pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
880
        }
881
    }
882
    
883
    # "*" is default
884
    else { push @sql, '*' }
885
    
886
    # Table
887
    unless ($selection) {
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
888
        push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-03-21
889
        if ($relation) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
890
            my $found = {};
891
            foreach my $table (@$tables) {
892
                push @sql, ($table, ',') unless $found->{$table};
893
                $found->{$table} = 1;
894
            }
packaging one directory
yuki-kimoto authored on 2009-11-16
895
        }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
896
        else {
897
            my $main_table = $tables->[-1] || '';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
898
            push @sql, $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
899
        }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
900
        pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
901
    }
902
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
903
    # Main table
904
    croak "Not found table name" unless $tables->[-1];
905
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
906
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
907
    my $w = $self->_where($where);
908
    $where = $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
909
    
910
    # String where
911
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
912
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
913
    # Add table names in where clause
914
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
915
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
916
    # Push join
917
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
918
    
cleanup
Yuki Kimoto authored on 2011-03-09
919
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
920
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
921
    
cleanup
Yuki Kimoto authored on 2011-03-08
922
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
923
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
924
    
cleanup
Yuki Kimoto authored on 2011-01-27
925
    # Append statement
926
    push @sql, $append if $append;
927
    
928
    # SQL
929
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
930
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
931
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
932
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
933
    return $query if $args{query};
934
    
packaging one directory
yuki-kimoto authored on 2009-11-16
935
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
936
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
937
        $query,
938
        param  => $where, 
939
        table => $tables,
940
        %args
941
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
942
    
943
    return $result;
944
}
945

            
cleanup
Yuki Kimoto authored on 2011-03-21
946
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
947

            
948
sub select_at {
949
    my ($self, %args) = @_;
950
    
cleanup
Yuki Kimoto authored on 2011-03-09
951
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
952
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
953
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
954
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
955
    }
956
    
957
    # Primary key
958
    my $primary_keys = delete $args{primary_key};
959
    $primary_keys = [$primary_keys] unless ref $primary_keys;
960
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
961
    # Table
962
    croak qq{"table" option must be specified} unless $args{table};
963
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
964
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
965
    # Where clause
966
    my $where = {};
967
    if (exists $args{where}) {
968
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
969
        
970
        croak qq{"where" must be constant value or array reference}
971
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
972
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
973
        $where_columns = [$where_columns] unless ref $where_columns;
974
        
975
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
976
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
977
        }
978
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
979
    
980
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
981
        my $param = delete $args{param};
982
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
983
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
984
        }
985
    }
986
    
987
    return $self->select(where => $where, %args);
988
}
989

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
990
sub setup_model {
991
    my $self = shift;
992
    
993
    $self->each_column(
994
        sub {
995
            my ($self, $table, $column, $column_info) = @_;
996
            
997
            if (my $model = $self->models->{$table}) {
998
                push @{$model->columns}, $column;
999
            }
1000
        }
1001
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1002
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1003
}
1004

            
cleanup
Yuki Kimoto authored on 2011-03-21
1005
our %UPDATE_ARGS
1006
  = map { $_ => 1 } @COMMON_ARGS, qw/param where append allow_update_all/;
cleanup
yuki-kimoto authored on 2010-10-17
1007

            
1008
sub update {
1009
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
1010
    
cleanup
Yuki Kimoto authored on 2011-03-09
1011
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1012
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1013
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1014
          unless $UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1015
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1016
    
cleanup
yuki-kimoto authored on 2010-10-17
1017
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1018
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1019
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1020
    my $param            = delete $args{param} || {};
1021
    my $where            = delete $args{where} || {};
1022
    my $append           = delete $args{append} || '';
1023
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1024
    
cleanup
yuki-kimoto authored on 2010-10-17
1025
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1026
    my @clumns = keys %$param;
1027

            
1028
    # Columns
1029
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1030
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1031
    foreach my $column (keys %$param) {
1032
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1033
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1034
        push @columns, $column;
1035
    }
1036
        
cleanup
yuki-kimoto authored on 2010-10-17
1037
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1038
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1039

            
1040
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1041
    my $w = $self->_where($where);
1042
    $where = $w->param;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1043
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1044
    # String where
1045
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1046
    
1047
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1048
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1049
    
cleanup
Yuki Kimoto authored on 2011-01-27
1050
    # SQL stack
1051
    my @sql;
1052
    
1053
    # Update
1054
    push @sql, "update $table $update_clause $swhere";
1055
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1056
    
cleanup
yuki-kimoto authored on 2010-10-17
1057
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1058
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1059
        
cleanup
yuki-kimoto authored on 2010-10-17
1060
        if (exists $param->{$wkey}) {
1061
            $param->{$wkey} = [$param->{$wkey}]
1062
              unless ref $param->{$wkey} eq 'ARRAY';
1063
            
1064
            push @{$param->{$wkey}}, $where->{$wkey};
1065
        }
1066
        else {
1067
            $param->{$wkey} = $where->{$wkey};
1068
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1069
    }
cleanup
yuki-kimoto authored on 2010-10-17
1070
    
cleanup
Yuki Kimoto authored on 2011-01-27
1071
    # SQL
1072
    my $sql = join(' ', @sql);
1073
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1074
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1075
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1076
    return $query if $args{query};
1077
    
cleanup
yuki-kimoto authored on 2010-10-17
1078
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1079
    my $ret_val = $self->execute(
1080
        $query,
1081
        param  => $param, 
1082
        table => $table,
1083
        %args
1084
    );
cleanup
yuki-kimoto authored on 2010-10-17
1085
    
1086
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1087
}
1088

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
1091
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1092

            
1093
sub update_at {
1094
    my ($self, %args) = @_;
1095
    
cleanup
Yuki Kimoto authored on 2011-03-09
1096
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1097
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1098
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1099
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1100
    }
1101
    
1102
    # Primary key
1103
    my $primary_keys = delete $args{primary_key};
1104
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1105
    
1106
    # Where clause
1107
    my $where = {};
1108
    my $param = {};
1109
    
1110
    if (exists $args{where}) {
1111
        my $where_columns = delete $args{where};
1112
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1113

            
1114
        croak qq{"where" must be constant value or array reference}
1115
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1116
        
1117
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1118
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1119
        }
1120
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1121
    
1122
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1123
        $param = delete $args{param};
1124
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1125
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1126
        }
1127
    }
1128
    
1129
    return $self->update(where => $where, param => $param, %args);
1130
}
1131

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1132
sub update_param {
1133
    my ($self, $param) = @_;
1134
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1135
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1136
    my @tag;
1137
    push @tag, '{update_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1138
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1139
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1140
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1141
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1142
        push @tag, $column;
1143
    }
1144
    push @tag, '}';
1145
    
1146
    return join ' ', @tag;
1147
}
1148

            
cleanup
Yuki Kimoto authored on 2011-01-25
1149
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1150
    my $self = shift;
1151

            
1152
    return DBIx::Custom::Where->new(
1153
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1154
        safety_character => $self->safety_character,
cleanup
Yuki Kimoto authored on 2011-03-09
1155
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1156
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1157
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1158

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1159
sub _bind {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1160
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1161
    
cleanup
Yuki Kimoto authored on 2011-01-12
1162
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1163
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1164
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1165
    # Build bind values
1166
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1167
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1168
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1169
        
1170
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1171
        my $value;
1172
        if(ref $params->{$column} eq 'ARRAY') {
1173
            my $i = $count->{$column} || 0;
1174
            $i += $not_exists->{$column} || 0;
1175
            my $found;
1176
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1177
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1178
                    $not_exists->{$column}++;
1179
                }
1180
                else  {
1181
                    $value = $params->{$column}->[$k];
1182
                    $found = 1;
1183
                    last
1184
                }
1185
            }
1186
            next unless $found;
1187
        }
1188
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1189
        
cleanup
Yuki Kimoto authored on 2011-01-12
1190
        # Filter
1191
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1192
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1193
        # Type
1194
        push @$bind, {
1195
            value => $f ? $f->($value) : $value,
1196
            type => $type->{$column}
1197
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1198
        
1199
        # Count up 
1200
        $count->{$column}++;
1201
    }
1202
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1203
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1204
}
1205

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1206
sub _connect {
1207
    my $self = shift;
1208
    
1209
    # Attributes
1210
    my $data_source = $self->data_source;
1211
    croak qq{"data_source" must be specified to connect()"}
1212
      unless $data_source;
1213
    my $user        = $self->user;
1214
    my $password    = $self->password;
1215
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1216
    
1217
    # Connect
1218
    my $dbh = eval {DBI->connect(
1219
        $data_source,
1220
        $user,
1221
        $password,
1222
        {
1223
            %{$self->default_dbi_option},
1224
            %$dbi_option
1225
        }
1226
    )};
1227
    
1228
    # Connect error
1229
    croak $@ if $@;
1230
    
1231
    return $dbh;
1232
}
1233

            
cleanup
yuki-kimoto authored on 2010-10-17
1234
sub _croak {
1235
    my ($self, $error, $append) = @_;
1236
    $append ||= "";
1237
    
1238
    # Verbose
1239
    if ($Carp::Verbose) { croak $error }
1240
    
1241
    # Not verbose
1242
    else {
1243
        
1244
        # Remove line and module infromation
1245
        my $at_pos = rindex($error, ' at ');
1246
        $error = substr($error, 0, $at_pos);
1247
        $error =~ s/\s+$//;
1248
        
1249
        croak "$error$append";
1250
    }
1251
}
1252

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1253
sub _need_tables {
1254
    my ($self, $tree, $need_tables, $tables) = @_;
1255
    
1256
    foreach my $table (@$tables) {
1257
        
1258
        if ($tree->{$table}) {
1259
            $need_tables->{$table} = 1;
1260
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1261
        }
1262
    }
1263
}
1264

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1265
sub _tables {
1266
    my ($self, $source) = @_;
1267
    
1268
    my $tables = [];
1269
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1270
    my $safety_character = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1271
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1272
    while ($source =~ /\b($safety_character+)\./g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1273
        push @$tables, $1;
1274
    }
1275
    
1276
    return $tables;
1277
}
1278

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1279
sub _push_join {
1280
    my ($self, $sql, $join, $join_tables) = @_;
1281
    
1282
    return unless @$join;
1283
    
1284
    my $tree = {};
1285
    
1286
    for (my $i = 0; $i < @$join; $i++) {
1287
        
1288
        my $join_clause = $join->[$i];
1289
        
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
1290
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1291
            
1292
            my $table1 = $1;
1293
            my $table2 = $2;
1294
            
1295
            croak qq{right side table of "$join_clause" must be uniq}
1296
              if exists $tree->{$table2};
1297
            
1298
            $tree->{$table2}
1299
              = {position => $i, parent => $table1, join => $join_clause};
1300
        }
1301
        else {
1302
            croak qq{join "$join_clause" must be two table name};
1303
        }
1304
    }
1305
    
1306
    my $need_tables = {};
1307
    $self->_need_tables($tree, $need_tables, $join_tables);
1308
    
1309
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1310

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1311
    foreach my $need_table (@need_tables) {
1312
        push @$sql, $tree->{$need_table}{join};
1313
    }
1314
}
cleanup
Yuki Kimoto authored on 2011-03-08
1315

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1316
sub _where {
1317
    my ($self, $where) = @_;
1318
    
1319
    my $w;
1320
    if (ref $where eq 'HASH') {
1321
        my $clause = ['and'];
1322
        push @$clause, "{= $_}" for keys %$where;
1323
        $w = $self->where(clause => $clause, param => $where);
1324
    }
1325
    elsif (ref $where eq 'DBIx::Custom::Where') {
1326
        $w = $where;
1327
    }
1328
    elsif (ref $where eq 'ARRAY') {
1329
        $w = $self->where(
1330
            clause => $where->[0],
1331
            param  => $where->[1]
1332
        );
1333
    }
1334
    
1335
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1336
          qq{or array reference, which contains where clause and paramter}
1337
      unless ref $w eq 'DBIx::Custom::Where';
1338
    
1339
    return $w;
1340
}
1341

            
cleanup
Yuki Kimoto authored on 2011-01-25
1342
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1343
__PACKAGE__->attr(
1344
    dbi_options => sub { {} },
1345
    filter_check  => 1
1346
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1347

            
cleanup
Yuki Kimoto authored on 2011-01-25
1348
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1349
sub default_bind_filter {
1350
    my $self = shift;
1351
    
1352
    if (@_) {
1353
        my $fname = $_[0];
1354
        
1355
        if (@_ && !$fname) {
1356
            $self->{default_out_filter} = undef;
1357
        }
1358
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1359
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1360
              unless exists $self->filters->{$fname};
1361
        
1362
            $self->{default_out_filter} = $self->filters->{$fname};
1363
        }
1364
        return $self;
1365
    }
1366
    
1367
    return $self->{default_out_filter};
1368
}
1369

            
cleanup
Yuki Kimoto authored on 2011-01-25
1370
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1371
sub default_fetch_filter {
1372
    my $self = shift;
1373
    
1374
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1375
        my $fname = $_[0];
1376

            
cleanup
Yuki Kimoto authored on 2011-01-12
1377
        if (@_ && !$fname) {
1378
            $self->{default_in_filter} = undef;
1379
        }
1380
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1381
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1382
              unless exists $self->filters->{$fname};
1383
        
1384
            $self->{default_in_filter} = $self->filters->{$fname};
1385
        }
1386
        
1387
        return $self;
1388
    }
1389
    
many changed
Yuki Kimoto authored on 2011-01-23
1390
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1391
}
1392

            
cleanup
Yuki Kimoto authored on 2011-01-25
1393
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1394
sub register_tag_processor {
1395
    return shift->query_builder->register_tag_processor(@_);
1396
}
1397

            
cleanup
Yuki Kimoto authored on 2011-03-08
1398
# DEPRECATED!
1399
sub _push_relation {
1400
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1401
    
1402
    if (keys %{$relation || {}}) {
1403
        push @$sql, $need_where ? 'where' : 'and';
1404
        foreach my $rcolumn (keys %$relation) {
1405
            my $table1 = (split (/\./, $rcolumn))[0];
1406
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1407
            push @$tables, ($table1, $table2);
1408
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1409
        }
1410
    }
1411
    pop @$sql if $sql->[-1] eq 'and';    
1412
}
1413

            
1414
# DEPRECATED!
1415
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1416
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1417
    
1418
    if (keys %{$relation || {}}) {
1419
        foreach my $rcolumn (keys %$relation) {
1420
            my $table1 = (split (/\./, $rcolumn))[0];
1421
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1422
            my $table1_exists;
1423
            my $table2_exists;
1424
            foreach my $table (@$tables) {
1425
                $table1_exists = 1 if $table eq $table1;
1426
                $table2_exists = 1 if $table eq $table2;
1427
            }
1428
            unshift @$tables, $table1 unless $table1_exists;
1429
            unshift @$tables, $table2 unless $table2_exists;
1430
        }
1431
    }
1432
}
1433

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1436
=head1 NAME
1437

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1438
DBIx::Custom - Useful database access, respecting SQL!
removed reconnect method
yuki-kimoto authored on 2010-05-28
1439

            
1440
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1441

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1442
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1443
    
1444
    # Connect
1445
    my $dbi = DBIx::Custom->connect(
1446
        data_source => "dbi:mysql:database=dbname",
1447
        user => 'ken',
1448
        password => '!LFKD%$&',
1449
        dbi_option => {mysql_enable_utf8 => 1}
1450
    );
cleanup
yuki-kimoto authored on 2010-08-05
1451

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1452
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1453
    $dbi->insert(
1454
        table  => 'book',
1455
        param  => {title => 'Perl', author => 'Ken'}
1456
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1457
    
1458
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1459
    $dbi->update(
1460
        table  => 'book', 
1461
        param  => {title => 'Perl', author => 'Ken'}, 
1462
        where  => {id => 5},
1463
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1464
    
1465
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1466
    $dbi->delete(
1467
        table  => 'book',
1468
        where  => {author => 'Ken'},
1469
    );
cleanup
yuki-kimoto authored on 2010-08-05
1470

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1471
    # Select
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
1472
    my $result = $dbi->select(
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1473
        table  => 'book',
update document
yuki-kimoto authored on 2010-05-27
1474
        where  => {author => 'Ken'},
added commit method
yuki-kimoto authored on 2010-05-27
1475
    );
cleanup
yuki-kimoto authored on 2010-08-05
1476

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1477
    # Select, more complex
1478
    my $result = $dbi->select(
1479
        table  => 'book',
1480
        column => [
1481
            'book.author as book__author',
1482
            'company.name as company__name'
1483
        ],
1484
        where  => {'book.author' => 'Ken'},
1485
        join => ['left outer join company on book.company_id = company.id'],
1486
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1487
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1488
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1489
    # Fetch
1490
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1491
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1492
    }
1493
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1494
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1495
    while (my $row = $result->fetch_hash) {
1496
        
1497
    }
1498
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1499
    # Execute SQL with parameter.
1500
    $dbi->execute(
1501
        "select id from book where {= author} and {like title}",
1502
        param  => {author => 'ken', title => '%Perl%'}
1503
    );
1504
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1505
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1506

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1507
L<DBIx::Custom> is L<DBI> wrapper module.
1508

            
1509
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1510

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1511
=over 4
removed reconnect method
yuki-kimoto authored on 2010-05-28
1512

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1513
=item *
removed reconnect method
yuki-kimoto authored on 2010-05-28
1514

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1515
There are many basic methods to execute various queries.
1516
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1517
C<delete_all()>, C<select()>,
1518
C<insert_at()>, C<update_at()>, 
1519
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1520

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1521
=item *
1522

            
1523
Filter when data is send or receive.
1524

            
1525
=item *
1526

            
1527
Data filtering system
1528

            
1529
=item *
1530

            
1531
Model support.
1532

            
1533
=item *
1534

            
1535
Generate where clause dinamically.
1536

            
1537
=item *
1538

            
1539
Generate join clause dinamically.
1540

            
1541
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1542

            
1543
=head1 GUIDE
1544

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1545
L<DBIx::Custom::Guide> - L<DBIx::Custom> Guide
pod fix
Yuki Kimoto authored on 2011-01-21
1546

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1547
=head1 Wiki
pod fix
Yuki Kimoto authored on 2011-01-21
1548

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1549
L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
updated document
yuki-kimoto authored on 2010-08-08
1550

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1558
Enable caching L<DBIx::Custom::Query>,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1559
default to 1.
packaging one directory
yuki-kimoto authored on 2009-11-16
1560

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1566
Data source, used when C<connect()> is executed.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1567

            
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1568
=head2 C<dbi_option>
added dbi_options attribute
kimoto authored on 2010-12-20
1569

            
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1570
    my $dbi_option = $dbi->dbi_option;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1571
    $dbi           = $dbi->dbi_option($dbi_option);
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1572

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1573
L<DBI> option, used when C<connect()> is executed.
1574
Each value in option override the value of C<default_dbi_option>.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1575

            
1576
=head2 C<default_dbi_option>
1577

            
1578
    my $default_dbi_option = $dbi->default_dbi_option;
1579
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1580

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1581
L<DBI> default option, used when C<connect()> is executed,
1582
default to the following values.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1583

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1584
    {
1585
        RaiseError => 1,
1586
        PrintError => 0,
1587
        AutoCommit => 1,
1588
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1589

            
update pod
Yuki Kimoto authored on 2011-03-13
1590
You should not change C<AutoCommit> value directly,
1591
the value is used to check if the process is in transaction.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1592

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1598
Filters, registered by C<register_filter()>.
add models() attribute
Yuki Kimoto authored on 2011-02-21
1599

            
update pod
Yuki Kimoto authored on 2011-03-13
1600
=head2 C<models> EXPERIMENTAL
add models() attribute
Yuki Kimoto authored on 2011-02-21
1601

            
1602
    my $models = $dbi->models;
1603
    $dbi       = $dbi->models(\%models);
1604

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1605
Models, included by C<include_model()>.
add models() attribute
Yuki Kimoto authored on 2011-02-21
1606

            
cleanup
yuki-kimoto authored on 2010-10-17
1607
=head2 C<password>
1608

            
1609
    my $password = $dbi->password;
1610
    $dbi         = $dbi->password('lkj&le`@s');
1611

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1612
Password, used when C<connect()> is executed.
update document
yuki-kimoto authored on 2010-01-30
1613

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1619
Query builder, default to L<DBIx::Custom::QueryBuilder> object.
cleanup
yuki-kimoto authored on 2010-08-05
1620

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1626
Result class, default to L<DBIx::Custom::Result>.
cleanup
yuki-kimoto authored on 2010-08-05
1627

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1628
=head2 C<safety_character>
update pod
Yuki Kimoto authored on 2011-01-27
1629

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1630
    my $safety_character = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-03-10
1631
    $dbi                 = $self->safety_character($character);
update pod
Yuki Kimoto authored on 2011-01-27
1632

            
update pod
Yuki Kimoto authored on 2011-03-13
1633
Regex of safety character for table and column name, default to '\w'.
cleanup
Yuki Kimoto authored on 2011-03-10
1634
Note that you don't have to specify like '[\w]'.
update pod
Yuki Kimoto authored on 2011-01-27
1635

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1638
    my $user = $dbi->user;
1639
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1640

            
cleanup
Yuki Kimoto authored on 2011-03-10
1641
User name, used when C<connect()> is executed.
update pod
Yuki Kimoto authored on 2011-01-27
1642

            
cleanup
yuki-kimoto authored on 2010-10-17
1643
=head1 METHODS
added commit method
yuki-kimoto authored on 2010-05-27
1644

            
cleanup
yuki-kimoto authored on 2010-10-17
1645
L<DBIx::Custom> inherits all methods from L<Object::Simple>
cleanup
Yuki Kimoto authored on 2011-03-10
1646
and use all methods of L<DBI>
cleanup
yuki-kimoto authored on 2010-10-17
1647
and implements the following new ones.
added check_filter attribute
yuki-kimoto authored on 2010-08-08
1648

            
update pod
Yuki Kimoto authored on 2011-03-13
1649
=head2 C<apply_filter> EXPERIMENTAL
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1650

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1651
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1652
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1653
        'issue_date' => {
1654
            out => 'tp_to_date',
1655
            in  => 'date_to_tp',
1656
            end => 'tp_to_displaydate'
1657
        },
1658
        'write_date' => {
1659
            out => 'tp_to_date',
1660
            in  => 'date_to_tp',
1661
            end => 'tp_to_displaydate'
1662
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1663
    );
1664

            
update pod
Yuki Kimoto authored on 2011-03-13
1665
Apply filter to columns.
1666
C<out> filter is executed before data is send to database.
1667
C<in> filter is executed after a row is fetch.
1668
C<end> filter is execute after C<in> filter is executed.
1669

            
1670
Filter is applied to the follwoing tree column name pattern.
cleanup
Yuki Kimoto authored on 2010-12-21
1671

            
update pod
Yuki Kimoto authored on 2011-03-13
1672
       PETTERN         EXAMPLE
1673
    1. Column        : author
1674
    2. Table.Column  : book.author
1675
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1676

            
update pod
Yuki Kimoto authored on 2011-03-13
1677
If column name is duplicate with other table,
1678
Main filter specified by C<table> option is used.
1679

            
1680
You can set multiple filters at once.
1681

            
1682
    $dbi->apply_filter(
1683
        'book',
1684
        [qw/issue_date write_date/] => {
1685
            out => 'tp_to_date',
1686
            in  => 'date_to_tp',
1687
            end => 'tp_to_displaydate'
1688
        }
1689
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1690

            
update pod
Yuki Kimoto authored on 2011-03-13
1691
=head2 C<cache_method>
1692

            
1693
    $dbi          = $dbi->cache_method(\&cache_method);
1694
    $cache_method = $dbi->cache_method
1695

            
update pod
Yuki Kimoto authored on 2011-03-13
1696
Method to set and get cache.
1697
Default to the following one.
1698

            
1699
    sub {
1700
        my $self = shift;
1701
        
1702
        $self->{_cached} ||= {};
1703
        
1704
        if (@_ > 1) {
1705
            $self->{_cached}{$_[0]} = $_[1];
1706
        }
1707
        else {
1708
            return $self->{_cached}{$_[0]};
1709
        }
1710
    }
update pod
Yuki Kimoto authored on 2011-03-13
1711

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1714
    my $dbi = DBIx::Custom->connect(
1715
        data_source => "dbi:mysql:database=dbname",
1716
        user => 'ken',
1717
        password => '!LFKD%$&',
1718
        dbi_option => {mysql_enable_utf8 => 1}
1719
    );
1720

            
1721
Connect to the database and create a new L<DBIx::Custom> object.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1722

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1723
L<DBIx::Custom> is a wrapper of L<DBI>.
cleanup
yuki-kimoto authored on 2010-08-09
1724
C<AutoCommit> and C<RaiseError> options are true, 
update pod
Yuki Kimoto authored on 2011-03-13
1725
and C<PrintError> option is false by default.
packaging one directory
yuki-kimoto authored on 2009-11-16
1726

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1727
=head2 create_model
1728

            
1729
    $dbi->create_model(
1730
        table => 'book',
1731
        primary_key => 'id',
1732
        join => [
1733
            'inner join company on book.comparny_id = company.id'
1734
        ],
1735
        filter => [
1736
            publish_date => {
1737
                out => 'tp_to_date',
1738
                in => 'date_to_tp',
1739
                end => 'tp_to_displaydate'
1740
            }
1741
        ]
1742
    );
1743

            
1744
Create L<DBIx::Custom::Model> object and initialize model.
1745
the module is used from model() method.
1746

            
1747
   $dbi->model('book')->select(...);
1748

            
cleanup
yuki-kimoto authored on 2010-10-17
1749
=head2 C<create_query>
1750
    
1751
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1752
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1753
    );
update document
yuki-kimoto authored on 2009-11-19
1754

            
update pod
Yuki Kimoto authored on 2011-03-13
1755
Create L<DBIx::Custom::Query> object.
1756

            
cleanup
yuki-kimoto authored on 2010-10-17
1757
If you want to get high performance,
update pod
Yuki Kimoto authored on 2011-03-13
1758
create L<DBIx::Custom::Query> object and execute the query by C<execute()>
1759
instead of other methods, such as C<insert>, C<update>.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1760

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

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1763
=head2 C<dbh>
1764

            
1765
    my $dbh = $dbi->dbh;
1766
    $dbi    = $dbi->dbh($dbh);
1767

            
1768
Get and set database handle of L<DBI>.
1769

            
update pod
Yuki Kimoto authored on 2011-03-13
1770
If process is spawn by forking, new connection is created automatically.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1771

            
1772
=head2 C<each_column>
1773

            
1774
    $dbi->each_column(
1775
        sub {
1776
            my ($dbi, $table, $column, $column_info) = @_;
1777
            
1778
            my $type = $column_info->{TYPE_NAME};
1779
            
1780
            if ($type eq 'DATE') {
1781
                # ...
1782
            }
1783
        }
1784
    );
1785

            
1786
Iterate all column informations of all table from database.
1787
Argument is callback when one column is found.
1788
Callback receive four arguments, dbi object, table name,
1789
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1790

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1793
    my $result = $dbi->execute(
1794
        "select * from book where {= title} and {like author}",
1795
        param => {title => 'Perl', author => '%Ken%'}
1796
    );
1797

            
1798
Execute SQL, containing tags.
1799
Return value is L<DBIx::Custom::Result> in select statement, or
1800
the count of affected rows in insert, update, delete statement.
1801

            
1802
Tag is turned into the statement containing place holder
1803
before SQL is executed.
1804

            
1805
    select * from where title = ? and author like ?;
1806

            
1807
See also L<Tags/Tags>.
1808

            
1809
The following opitons are currently available.
1810

            
1811
=over 4
1812

            
1813
=item C<filter>
1814

            
1815
Filter, executed before data is send to database. This is array reference.
1816
Filter value is code reference or
1817
filter name registerd by C<register_filter()>.
1818

            
1819
    # Basic
1820
    $dbi->execute(
1821
        $sql,
1822
        filter => [
1823
            title  => sub { uc $_[0] }
1824
            author => sub { uc $_[0] }
1825
        ]
1826
    );
1827
    
1828
    # At once
1829
    $dbi->execute(
1830
        $sql,
1831
        filter => [
1832
            [qw/title author/]  => sub { uc $_[0] }
1833
        ]
1834
    );
1835
    
1836
    # Filter name
1837
    $dbi->execute(
1838
        $sql,
1839
        filter => [
1840
            title  => 'upper_case',
1841
            author => 'upper_case'
1842
        ]
1843
    );
1844

            
1845
These filters are added to the C<out> filters, set by C<apply_filter()>.
update document
yuki-kimoto authored on 2009-11-19
1846

            
update pod
Yuki Kimoto authored on 2011-03-13
1847
=back
version 0.0901
yuki-kimoto authored on 2009-12-17
1848

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1851
    $dbi->delete(table => 'book', where => {title => 'Perl'});
1852

            
1853
Delete statement.
1854

            
1855
The following opitons are currently available.
1856

            
update pod
Yuki Kimoto authored on 2011-03-13
1857
=over 4
1858

            
update pod
Yuki Kimoto authored on 2011-03-13
1859
=item C<table>
1860

            
1861
Table name.
1862

            
1863
    $dbi->delete(table => 'book');
1864

            
1865
=item C<where>
1866

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1867
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1868
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1869
    
1870
    # Hash reference
1871
    $dbi->delete(where => {title => 'Perl'});
1872
    
1873
    # DBIx::Custom::Where object
1874
    my $where = $dbi->where(
1875
        clause => ['and', '{= author}', '{like title}'],
1876
        param  => {author => 'Ken', title => '%Perl%'}
1877
    );
1878
    $dbi->delete(where => $where);
1879

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1880
    # Array refrendce (where clause and parameter)
1881
    $dbi->delete(where =>
1882
        [
1883
            ['and', '{= author}', '{like title}'],
1884
            {author => 'Ken', title => '%Perl%'}
1885
        ]
1886
    );
1887
    
update pod
Yuki Kimoto authored on 2011-03-13
1888
=item C<append>
1889

            
1890
Append statement to last of SQL. This is string.
1891

            
1892
    $dbi->delete(append => 'order by title');
1893

            
1894
=item C<filter>
1895

            
1896
Filter, executed before data is send to database. This is array reference.
1897
Filter value is code reference or
1898
filter name registerd by C<register_filter()>.
1899

            
1900
    # Basic
1901
    $dbi->delete(
1902
        filter => [
1903
            title  => sub { uc $_[0] }
1904
            author => sub { uc $_[0] }
1905
        ]
1906
    );
1907
    
1908
    # At once
1909
    $dbi->delete(
1910
        filter => [
1911
            [qw/title author/]  => sub { uc $_[0] }
1912
        ]
1913
    );
1914
    
1915
    # Filter name
1916
    $dbi->delete(
1917
        filter => [
1918
            title  => 'upper_case',
1919
            author => 'upper_case'
1920
        ]
1921
    );
1922

            
1923
These filters are added to the C<out> filters, set by C<apply_filter()>.
1924

            
cleanup
Yuki Kimoto authored on 2011-03-21
1925
=head2 C<column> EXPERIMENTAL
1926

            
1927
    my $column = $self->column(book => ['author', 'title']);
1928

            
1929
Create column clause. The follwoing column clause is created.
1930

            
1931
    book.author as book__author,
1932
    book.title as book__title
1933

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1934
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
1935

            
1936
Get L<DBIx::Custom::Query> object instead of executing SQL.
1937
This is true or false value.
1938

            
1939
    my $query = $dbi->delete(query => 1);
1940

            
1941
You can check SQL.
1942

            
1943
    my $sql = $query->sql;
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1944

            
update pod
Yuki Kimoto authored on 2011-03-13
1945
=back
1946

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1951
Delete statement to delete all rows.
1952
Options is same as C<delete()>.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1953

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1954
=head2 C<delete_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1955

            
update pod
Yuki Kimoto authored on 2011-03-13
1956
Delete statement, using primary key.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1957

            
1958
    $dbi->delete_at(
1959
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1960
        primary_key => 'id',
1961
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1962
    );
1963

            
update pod
Yuki Kimoto authored on 2011-03-13
1964
This method is same as C<delete()> exept that
1965
C<primary_key> is specified and C<where> is constant value or array refrence.
1966
all option of C<delete()> is available.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1967

            
update pod
Yuki Kimoto authored on 2011-03-13
1968
=over 4
1969

            
1970
=item C<primary_key>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1971

            
update pod
Yuki Kimoto authored on 2011-03-13
1972
Primary key. This is constant value or array reference.
1973
    
1974
    # Constant value
1975
    $dbi->delete(primary_key => 'id');
1976

            
1977
    # Array reference
1978
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1979

            
1980
This is used to create where clause.
1981

            
update pod
Yuki Kimoto authored on 2011-03-13
1982
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
1983

            
1984
Where clause, created from primary key information.
1985
This is constant value or array reference.
1986

            
1987
    # Constant value
1988
    $dbi->delete(where => 5);
1989

            
1990
    # Array reference
1991
    $dbi->delete(where => [3, 5]);
1992

            
1993
In first examle, the following SQL is created.
1994

            
1995
    delete from book where id = ?;
1996

            
1997
Place holder is set to 5.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1998

            
update pod
Yuki Kimoto authored on 2011-03-13
1999
=back
2000

            
cleanup
yuki-kimoto authored on 2010-10-17
2001
=head2 C<insert>
2002

            
update pod
Yuki Kimoto authored on 2011-03-13
2003
    $dbi->insert(
2004
        table  => 'book', 
2005
        param  => {title => 'Perl', author => 'Ken'}
2006
    );
2007

            
2008
Insert statement.
2009

            
2010
The following opitons are currently available.
2011

            
update pod
Yuki Kimoto authored on 2011-03-13
2012
=over 4
2013

            
update pod
Yuki Kimoto authored on 2011-03-13
2014
=item C<table>
2015

            
2016
Table name.
2017

            
2018
    $dbi->insert(table => 'book');
2019

            
2020
=item C<param>
2021

            
2022
Insert data. This is hash reference.
2023

            
2024
    $dbi->insert(param => {title => 'Perl'});
2025

            
2026
=item C<append>
2027

            
2028
Append statement to last of SQL. This is string.
2029

            
2030
    $dbi->insert(append => 'order by title');
2031

            
2032
=item C<filter>
2033

            
2034
Filter, executed before data is send to database. This is array reference.
2035
Filter value is code reference or
2036
filter name registerd by C<register_filter()>.
2037

            
2038
    # Basic
2039
    $dbi->insert(
2040
        filter => [
2041
            title  => sub { uc $_[0] }
2042
            author => sub { uc $_[0] }
2043
        ]
2044
    );
2045
    
2046
    # At once
2047
    $dbi->insert(
2048
        filter => [
2049
            [qw/title author/]  => sub { uc $_[0] }
2050
        ]
2051
    );
2052
    
2053
    # Filter name
2054
    $dbi->insert(
2055
        filter => [
2056
            title  => 'upper_case',
2057
            author => 'upper_case'
2058
        ]
2059
    );
2060

            
2061
These filters are added to the C<out> filters, set by C<apply_filter()>.
2062

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2063
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
2064

            
2065
Get L<DBIx::Custom::Query> object instead of executing SQL.
2066
This is true or false value.
2067

            
2068
    my $query = $dbi->insert(query => 1);
cleanup
yuki-kimoto authored on 2010-10-17
2069

            
update pod
Yuki Kimoto authored on 2011-03-13
2070
You can check SQL.
cleanup
yuki-kimoto authored on 2010-10-17
2071

            
update pod
Yuki Kimoto authored on 2011-03-13
2072
    my $sql = $query->sql;
2073

            
update pod
Yuki Kimoto authored on 2011-03-13
2074
=back
2075

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2076
=head2 C<insert_at()>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2077

            
update pod
Yuki Kimoto authored on 2011-03-13
2078
Insert statement, using primary key.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2079

            
2080
    $dbi->insert_at(
2081
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2082
        primary_key => 'id',
2083
        where => '5',
2084
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2085
    );
2086

            
update pod
Yuki Kimoto authored on 2011-03-13
2087
This method is same as C<insert()> exept that
2088
C<primary_key> is specified and C<where> is constant value or array refrence.
2089
all option of C<insert()> is available.
2090

            
update pod
Yuki Kimoto authored on 2011-03-13
2091
=over 4
2092

            
2093
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2094

            
2095
Primary key. This is constant value or array reference.
2096
    
2097
    # Constant value
2098
    $dbi->insert(primary_key => 'id');
2099

            
2100
    # Array reference
2101
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2102

            
2103
This is used to create parts of insert data.
2104

            
update pod
Yuki Kimoto authored on 2011-03-13
2105
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2106

            
2107
Parts of Insert data, create from primary key information.
2108
This is constant value or array reference.
2109

            
2110
    # Constant value
2111
    $dbi->insert(where => 5);
2112

            
2113
    # Array reference
2114
    $dbi->insert(where => [3, 5]);
2115

            
2116
In first examle, the following SQL is created.
2117

            
2118
    insert into book (id, title) values (?, ?);
2119

            
2120
Place holders are set to 5 and 'Perl'.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2121

            
update pod
Yuki Kimoto authored on 2011-03-13
2122
=back
2123

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2124
=head2 C<insert_param>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2125

            
2126
    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2127

            
2128
Create insert parameter tag.
2129

            
update pod
Yuki Kimoto authored on 2011-03-13
2130
    {insert_param title age}
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2131

            
update pod
Yuki Kimoto authored on 2011-03-13
2132
=head2 C<include_model> EXPERIMENTAL
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2133

            
update pod
Yuki Kimoto authored on 2011-03-13
2134
    $dbi->include_model('MyModel');
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2135

            
update pod
Yuki Kimoto authored on 2011-03-13
2136
Include models from specified namespace,
2137
the following layout is needed to include models.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2138

            
update pod
Yuki Kimoto authored on 2011-03-13
2139
    lib / MyModel.pm
2140
        / MyModel / book.pm
2141
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2142

            
update pod
Yuki Kimoto authored on 2011-03-13
2143
Name space module, extending L<DBIx::Custom::Model>.
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2144

            
update pod
Yuki Kimoto authored on 2011-03-13
2145
B<MyModel.pm>
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2146

            
2147
    package MyModel;
2148
    
2149
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2150
    
2151
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2152

            
update pod
Yuki Kimoto authored on 2011-03-13
2153
Model modules, extending name space module.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2154

            
update pod
Yuki Kimoto authored on 2011-03-13
2155
B<MyModel/book.pm>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2156

            
update pod
Yuki Kimoto authored on 2011-03-13
2157
    package MyModel::book;
2158
    
2159
    use base 'MyModel';
2160
    
2161
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2162

            
update pod
Yuki Kimoto authored on 2011-03-13
2163
B<MyModel/company.pm>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2164

            
update pod
Yuki Kimoto authored on 2011-03-13
2165
    package MyModel::company;
2166
    
2167
    use base 'MyModel';
2168
    
2169
    1;
2170
    
2171
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2172

            
update pod
Yuki Kimoto authored on 2011-03-13
2173
You can get model object by C<model()>.
2174

            
2175
    my $book_model    = $dbi->model('book');
2176
    my $company_model = $dbi->model('company');
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2177

            
update pod
Yuki Kimoto authored on 2011-03-13
2178
See L<DBIx::Custom::Model> to know model features.
2179

            
2180
=head2 C<method> EXPERIMENTAL
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2181

            
2182
    $dbi->method(
2183
        update_or_insert => sub {
2184
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2185
            
2186
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2187
        },
2188
        find_or_create   => sub {
2189
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2190
            
2191
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2192
        }
2193
    );
2194

            
update pod
Yuki Kimoto authored on 2011-03-13
2195
Register method. These method is called directly from L<DBIx::Custom> object.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2196

            
2197
    $dbi->update_or_insert;
2198
    $dbi->find_or_create;
2199

            
update pod
Yuki Kimoto authored on 2011-03-13
2200
=head2 C<model> EXPERIMENTAL
2201

            
2202
    $dbi->model('book')->method(
2203
        insert => sub { ... },
2204
        update => sub { ... }
2205
    );
2206
    
2207
    my $model = $dbi->model('book');
2208

            
2209
Set and get a L<DBIx::Custom::Model> object,
2210

            
cleanup
Yuki Kimoto authored on 2011-03-21
2211
=head2 C<mycolumn> EXPERIMENTAL
2212

            
2213
    my $column = $self->mycolumn(book => ['author', 'title']);
2214

            
2215
Create column clause for myself. The follwoing column clause is created.
2216

            
2217
    book.author as author,
2218
    book.title as title
2219

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2220
=head2 C<new>
2221

            
update pod
Yuki Kimoto authored on 2011-03-13
2222
    my $dbi = DBIx::Custom->new(
2223
        data_source => "dbi:mysql:database=dbname",
2224
        user => 'ken',
2225
        password => '!LFKD%$&',
2226
        dbi_option => {mysql_enable_utf8 => 1}
2227
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2228

            
2229
Create a new L<DBIx::Custom> object.
2230

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2231
=head2 C<not_exists>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2232

            
2233
    my $not_exists = $dbi->not_exists;
2234

            
update pod
Yuki Kimoto authored on 2011-03-13
2235
DBIx::Custom::NotExists object, indicating the column is not exists.
2236
This is used by C<clause> of L<DBIx::Custom::Where> .
experimental extended select...
Yuki Kimoto authored on 2011-01-17
2237

            
cleanup
yuki-kimoto authored on 2010-10-17
2238
=head2 C<register_filter>
2239

            
update pod
Yuki Kimoto authored on 2011-03-13
2240
    $dbi->register_filter(
2241
        # Time::Piece object to database DATE format
2242
        tp_to_date => sub {
2243
            my $tp = shift;
2244
            return $tp->strftime('%Y-%m-%d');
2245
        },
2246
        # database DATE format to Time::Piece object
2247
        date_to_tp => sub {
2248
           my $date = shift;
2249
           return Time::Piece->strptime($date, '%Y-%m-%d');
2250
        }
2251
    );
cleanup
yuki-kimoto authored on 2010-10-17
2252
    
update pod
Yuki Kimoto authored on 2011-03-13
2253
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2254

            
update pod
Yuki Kimoto authored on 2011-03-13
2255
=head2 C<register_tag>
cleanup
yuki-kimoto authored on 2010-10-17
2256

            
update pod
Yuki Kimoto authored on 2011-03-13
2257
    $dbi->register_tag(
2258
        update => sub {
2259
            my @columns = @_;
2260
            
2261
            # Update parameters
2262
            my $s = 'set ';
2263
            $s .= "$_ = ?, " for @columns;
2264
            $s =~ s/, $//;
2265
            
2266
            return [$s, \@columns];
2267
        }
2268
    );
cleanup
yuki-kimoto authored on 2010-10-17
2269

            
update pod
Yuki Kimoto authored on 2011-03-13
2270
Register tag, used by C<execute()>.
cleanup
yuki-kimoto authored on 2010-10-17
2271

            
update pod
Yuki Kimoto authored on 2011-03-13
2272
See also L<Tags/Tags> about tag registered by default.
cleanup
yuki-kimoto authored on 2010-10-17
2273

            
update pod
Yuki Kimoto authored on 2011-03-13
2274
Tag parser receive arguments specified in tag.
2275
In the following tag, 'title' and 'author' is parser arguments
cleanup
yuki-kimoto authored on 2010-10-17
2276

            
update pod
Yuki Kimoto authored on 2011-03-13
2277
    {update_param title author} 
cleanup
yuki-kimoto authored on 2010-10-17
2278

            
update pod
Yuki Kimoto authored on 2011-03-13
2279
Tag parser must return array refrence,
2280
first element is the result statement, 
2281
second element is column names corresponding to place holders.
cleanup
yuki-kimoto authored on 2010-10-17
2282

            
update pod
Yuki Kimoto authored on 2011-03-13
2283
In this example, result statement is 
cleanup
yuki-kimoto authored on 2010-10-17
2284

            
update pod
Yuki Kimoto authored on 2011-03-13
2285
    set title = ?, author = ?
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2286

            
update pod
Yuki Kimoto authored on 2011-03-13
2287
Column names is
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2288

            
update pod
Yuki Kimoto authored on 2011-03-13
2289
    ['title', 'author']
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2290

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2291
=head2 C<select>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2292

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2293
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2294
        table  => 'book',
2295
        column => ['author', 'title'],
2296
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2297
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2298
    
update pod
Yuki Kimoto authored on 2011-03-12
2299
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2300

            
2301
The following opitons are currently available.
2302

            
2303
=over 4
2304

            
2305
=item C<table>
2306

            
2307
Table name.
2308

            
update pod
Yuki Kimoto authored on 2011-03-12
2309
    $dbi->select(table => 'book');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2310

            
2311
=item C<column>
2312

            
2313
Column clause. This is array reference or constant value.
2314

            
2315
    # Hash refernce
2316
    $dbi->select(column => ['author', 'title']);
2317
    
2318
    # Constant value
2319
    $dbi->select(column => 'author');
2320

            
2321
Default is '*' unless C<column> is specified.
2322

            
2323
    # Default
2324
    $dbi->select(column => '*');
2325

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2326
You can use hash option in C<column>
2327

            
2328
=over 4
2329

            
2330
=item all EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2331

            
update pod
Yuki Kimoto authored on 2011-03-12
2332
Colum clause, contains all columns of joined table. This is true or false value
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2333

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2334
    $dbi->select(column => {all => 1});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2335

            
2336
If main table is C<book> and joined table is C<company>,
2337
This create the following column clause.
2338

            
2339
    book.author as author
2340
    book.company_id as company_id
2341
    company.id as company__id
2342
    company.name as company__name
2343

            
2344
Columns of main table is consist of only column name,
2345
Columns of joined table is consist of table and column name joined C<__>.
2346

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2347
Note that this option is failed unless modles is included and
2348
C<columns> attribute is set.
update pod
Yuki Kimoto authored on 2011-03-12
2349

            
2350
    # Generally do the following way before using all_column option
2351
    $dbi->include_model('MyModel')->setup_model;
2352

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2353
=item table EXPERIMENTAL
2354

            
2355
You can also specify table names by C<table> option
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2356

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2357
    $dbi->select(column => {table => ['book', 'company']});
2358

            
2359
=item prepend EXPERIMENTAL
2360

            
2361
You can add before created statement
2362

            
2363
    $dbi->select(column => {prepend => 'SOME', all => 1});
2364

            
2365
=back
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2366

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2367
=item C<where>
2368

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2369
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2370
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2371
    
2372
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2373
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2374
    
update pod
Yuki Kimoto authored on 2011-03-12
2375
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2376
    my $where = $dbi->where(
2377
        clause => ['and', '{= author}', '{like title}'],
2378
        param  => {author => 'Ken', title => '%Perl%'}
2379
    );
update pod
Yuki Kimoto authored on 2011-03-12
2380
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2381

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2382
    # Array refrendce (where clause and parameter)
2383
    $dbi->select(where =>
2384
        [
2385
            ['and', '{= author}', '{like title}'],
2386
            {author => 'Ken', title => '%Perl%'}
2387
        ]
2388
    );
2389
    
update pod
Yuki Kimoto authored on 2011-03-13
2390
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2391

            
update pod
Yuki Kimoto authored on 2011-03-12
2392
Join clause used in need. This is array reference.
2393

            
2394
    $dbi->select(join =>
2395
        [
2396
            'left outer join company on book.company_id = company_id',
2397
            'left outer join location on company.location_id = location.id'
2398
        ]
2399
    );
2400

            
2401
If column cluase or where clause contain table name like "company.name",
2402
needed join clause is used automatically.
2403

            
2404
    $dbi->select(
2405
        table => 'book',
2406
        column => ['company.location_id as company__location_id'],
2407
        where => {'company.name' => 'Orange'},
2408
        join => [
2409
            'left outer join company on book.company_id = company.id',
2410
            'left outer join location on company.location_id = location.id'
2411
        ]
2412
    );
2413

            
2414
In above select, the following SQL is created.
2415

            
2416
    select company.location_id as company__location_id
2417
    from book
2418
      left outer join company on book.company_id = company.id
2419
    where company.name = Orange
2420

            
2421
=item C<append>
2422

            
update pod
Yuki Kimoto authored on 2011-03-13
2423
Append statement to last of SQL. This is string.
update pod
Yuki Kimoto authored on 2011-03-12
2424

            
2425
    $dbi->select(append => 'order by title');
2426

            
2427
=item C<filter>
2428

            
update pod
Yuki Kimoto authored on 2011-03-13
2429
Filter, executed before data is send to database. This is array reference.
2430
Filter value is code reference or
update pod
Yuki Kimoto authored on 2011-03-12
2431
filter name registerd by C<register_filter()>.
2432

            
2433
    # Basic
2434
    $dbi->select(
2435
        filter => [
2436
            title  => sub { uc $_[0] }
2437
            author => sub { uc $_[0] }
2438
        ]
2439
    );
2440
    
2441
    # At once
2442
    $dbi->select(
2443
        filter => [
2444
            [qw/title author/]  => sub { uc $_[0] }
2445
        ]
2446
    );
2447
    
2448
    # Filter name
2449
    $dbi->select(
2450
        filter => [
2451
            title  => 'upper_case',
2452
            author => 'upper_case'
2453
        ]
2454
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2455

            
update pod
Yuki Kimoto authored on 2011-03-13
2456
These filters are added to the C<out> filters, set by C<apply_filter()>.
update document
yuki-kimoto authored on 2009-11-19
2457

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2458
=item C<query>
cleanup
yuki-kimoto authored on 2010-08-09
2459

            
update pod
Yuki Kimoto authored on 2011-03-12
2460
Get L<DBIx::Custom::Query> object instead of executing SQL.
2461
This is true or false value.
2462

            
update pod
Yuki Kimoto authored on 2011-03-13
2463
    my $query = $dbi->select(query => 1);
update pod
Yuki Kimoto authored on 2011-03-12
2464

            
update pod
Yuki Kimoto authored on 2011-03-13
2465
You can check SQL.
update pod
Yuki Kimoto authored on 2011-03-12
2466

            
2467
    my $sql = $query->sql;
2468

            
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
2469
=item C<type> EXPERIMENTAL
2470

            
2471
Specify database data type.
2472

            
2473
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2474
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2475

            
2476
This is used to bind paramter by C<bind_param()> of statment handle.
2477

            
2478
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2479

            
update pod
Yuki Kimoto authored on 2011-03-12
2480
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2481

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2482
=head2 C<select_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2483

            
update pod
Yuki Kimoto authored on 2011-03-12
2484
Select statement, using primary key.
2485

            
2486
    $dbi->select_at(
2487
        table => 'book',
2488
        primary_key => 'id',
2489
        where => '5'
2490
    );
2491

            
update pod
Yuki Kimoto authored on 2011-03-13
2492
This method is same as C<select()> exept that
2493
C<primary_key> is specified and C<where> is constant value or array refrence.
update pod
Yuki Kimoto authored on 2011-03-12
2494
all option of C<select()> is available.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2495

            
update pod
Yuki Kimoto authored on 2011-03-13
2496
=over 4
2497

            
2498
=item C<primary_key>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2499

            
update pod
Yuki Kimoto authored on 2011-03-12
2500
Primary key. This is constant value or array reference.
2501
    
2502
    # Constant value
2503
    $dbi->select(primary_key => 'id');
2504

            
2505
    # Array reference
2506
    $dbi->select(primary_key => ['id1', 'id2' ]);
2507

            
update pod
Yuki Kimoto authored on 2011-03-13
2508
This is used to create where clause.
2509

            
update pod
Yuki Kimoto authored on 2011-03-13
2510
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-12
2511

            
update pod
Yuki Kimoto authored on 2011-03-13
2512
Where clause, created from primary key information.
update pod
Yuki Kimoto authored on 2011-03-12
2513
This is constant value or array reference.
2514

            
2515
    # Constant value
2516
    $dbi->select(where => 5);
2517

            
2518
    # Array reference
2519
    $dbi->select(where => [3, 5]);
2520

            
2521
In first examle, the following SQL is created.
2522

            
2523
    select * from book where id = ?
2524

            
2525
Place holder is set to 5.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2526

            
update pod
Yuki Kimoto authored on 2011-03-13
2527
=back
2528

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2531
    $dbi->update(
2532
        table  => 'book',
2533
        param  => {title => 'Perl'},
2534
        where  => {id => 4}
2535
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2536

            
update pod
Yuki Kimoto authored on 2011-03-13
2537
Update statement.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2538

            
update pod
Yuki Kimoto authored on 2011-03-13
2539
The following opitons are currently available.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2540

            
update pod
Yuki Kimoto authored on 2011-03-13
2541
=over 4
2542

            
update pod
Yuki Kimoto authored on 2011-03-13
2543
=item C<table>
2544

            
update pod
Yuki Kimoto authored on 2011-03-13
2545
Table name.
2546

            
2547
    $dbi->update(table => 'book');
2548

            
2549
=item C<param>
2550

            
2551
Update data. This is hash reference.
2552

            
2553
    $dbi->update(param => {title => 'Perl'});
2554

            
2555
=item C<where>
2556

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2557
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2558
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2559
    
2560
    # Hash reference
2561
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2562
    
2563
    # DBIx::Custom::Where object
2564
    my $where = $dbi->where(
2565
        clause => ['and', '{= author}', '{like title}'],
2566
        param  => {author => 'Ken', title => '%Perl%'}
2567
    );
2568
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2569
    
2570
    # Array refrendce (where clause and parameter)
2571
    $dbi->update(where =>
2572
        [
2573
            ['and', '{= author}', '{like title}'],
2574
            {author => 'Ken', title => '%Perl%'}
2575
        ]
2576
    );
update pod
Yuki Kimoto authored on 2011-03-13
2577

            
2578
=item C<append>
2579

            
2580
Append statement to last of SQL. This is string.
2581

            
2582
    $dbi->update(append => 'order by title');
2583

            
2584
=item C<filter>
2585

            
2586
Filter, executed before data is send to database. This is array reference.
2587
Filter value is code reference or
2588
filter name registerd by C<register_filter()>.
2589

            
2590
    # Basic
2591
    $dbi->update(
2592
        filter => [
2593
            title  => sub { uc $_[0] }
2594
            author => sub { uc $_[0] }
2595
        ]
2596
    );
2597
    
2598
    # At once
2599
    $dbi->update(
2600
        filter => [
2601
            [qw/title author/]  => sub { uc $_[0] }
2602
        ]
2603
    );
2604
    
2605
    # Filter name
2606
    $dbi->update(
2607
        filter => [
2608
            title  => 'upper_case',
2609
            author => 'upper_case'
2610
        ]
2611
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2612

            
update pod
Yuki Kimoto authored on 2011-03-13
2613
These filters are added to the C<out> filters, set by C<apply_filter()>.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2614

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2615
=item C<query>
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2616

            
update pod
Yuki Kimoto authored on 2011-03-13
2617
Get L<DBIx::Custom::Query> object instead of executing SQL.
2618
This is true or false value.
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2619

            
update pod
Yuki Kimoto authored on 2011-03-13
2620
    my $query = $dbi->update(query => 1);
2621

            
2622
You can check SQL.
2623

            
2624
    my $sql = $query->sql;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2625

            
update pod
Yuki Kimoto authored on 2011-03-13
2626
=back
2627

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2630
    $dbi->update_all(table => 'book', param => {title => 'Perl'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2631

            
update pod
Yuki Kimoto authored on 2011-03-13
2632
Update statement to update all rows.
2633
Options is same as C<update()>.
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2634

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2635
=head2 C<update_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2636

            
update pod
Yuki Kimoto authored on 2011-03-13
2637
Update statement, using primary key.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2638

            
2639
    $dbi->update_at(
2640
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2641
        primary_key => 'id',
2642
        where => '5',
2643
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2644
    );
2645

            
update pod
Yuki Kimoto authored on 2011-03-13
2646
This method is same as C<update()> exept that
2647
C<primary_key> is specified and C<where> is constant value or array refrence.
2648
all option of C<update()> is available.
2649

            
update pod
Yuki Kimoto authored on 2011-03-13
2650
=over 4
2651

            
2652
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2653

            
2654
Primary key. This is constant value or array reference.
2655
    
2656
    # Constant value
2657
    $dbi->update(primary_key => 'id');
2658

            
2659
    # Array reference
2660
    $dbi->update(primary_key => ['id1', 'id2' ]);
2661

            
2662
This is used to create where clause.
2663

            
update pod
Yuki Kimoto authored on 2011-03-13
2664
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2665

            
2666
Where clause, created from primary key information.
2667
This is constant value or array reference.
2668

            
2669
    # Constant value
2670
    $dbi->update(where => 5);
2671

            
2672
    # Array reference
2673
    $dbi->update(where => [3, 5]);
2674

            
2675
In first examle, the following SQL is created.
2676

            
2677
    update book set title = ? where id = ?
2678

            
2679
Place holders are set to 'Perl' and 5.
2680

            
update pod
Yuki Kimoto authored on 2011-03-13
2681
=back
2682

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2683
=head2 C<update_param>
update pod
Yuki Kimoto authored on 2011-03-13
2684

            
2685
    my $update_param = $dbi->update_param({title => 'a', age => 2});
2686

            
2687
Create update parameter tag.
2688

            
2689
    {update_param title age}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2690

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2691
=head2 C<where>
fix tests
Yuki Kimoto authored on 2011-01-18
2692

            
cleanup
Yuki Kimoto authored on 2011-03-09
2693
    my $where = $dbi->where(
2694
        clause => ['and', '{= title}', '{= author}'],
2695
        param => {title => 'Perl', author => 'Ken'}
2696
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2697

            
2698
Create a new L<DBIx::Custom::Where> object.
2699

            
update pod
Yuki Kimoto authored on 2011-03-13
2700
=head2 C<setup_model> EXPERIMENTAL
cleanup
Yuki Kimoto authored on 2011-01-12
2701

            
update pod
Yuki Kimoto authored on 2011-03-13
2702
    $dbi->setup_model;
cleanup
Yuki Kimoto authored on 2011-01-12
2703

            
update pod
Yuki Kimoto authored on 2011-03-13
2704
Setup all model objects.
update pod
Yuki Kimoto authored on 2011-03-13
2705
C<columns> of model object is automatically set, parsing database information.
cleanup
Yuki Kimoto authored on 2011-01-12
2706

            
cleanup
Yuki Kimoto authored on 2011-01-25
2707
=head1 Tags
2708

            
2709
The following tags is available.
2710

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2711
=head2 C<table>
add table tag
Yuki Kimoto authored on 2011-02-09
2712

            
2713
Table tag
2714

            
2715
    {table TABLE}    ->    TABLE
2716

            
update pod
Yuki Kimoto authored on 2011-03-13
2717
This is used to tell C<execute()> what table is needed .
add table tag
Yuki Kimoto authored on 2011-02-09
2718

            
cleanup
Yuki Kimoto authored on 2011-01-25
2719
=head2 C<?>
2720

            
2721
Placeholder tag.
2722

            
2723
    {? NAME}    ->   ?
2724

            
2725
=head2 C<=>
2726

            
2727
Equal tag.
2728

            
2729
    {= NAME}    ->   NAME = ?
2730

            
2731
=head2 C<E<lt>E<gt>>
2732

            
2733
Not equal tag.
2734

            
2735
    {<> NAME}   ->   NAME <> ?
2736

            
2737
=head2 C<E<lt>>
2738

            
2739
Lower than tag
2740

            
2741
    {< NAME}    ->   NAME < ?
2742

            
2743
=head2 C<E<gt>>
2744

            
2745
Greater than tag
2746

            
2747
    {> NAME}    ->   NAME > ?
2748

            
2749
=head2 C<E<gt>=>
2750

            
2751
Greater than or equal tag
2752

            
2753
    {>= NAME}   ->   NAME >= ?
2754

            
2755
=head2 C<E<lt>=>
2756

            
2757
Lower than or equal tag
2758

            
2759
    {<= NAME}   ->   NAME <= ?
2760

            
2761
=head2 C<like>
2762

            
2763
Like tag
2764

            
2765
    {like NAME}   ->   NAME like ?
2766

            
2767
=head2 C<in>
2768

            
2769
In tag.
2770

            
2771
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2772

            
2773
=head2 C<insert_param>
2774

            
2775
Insert parameter tag.
2776

            
2777
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2778

            
2779
=head2 C<update_param>
2780

            
2781
Updata parameter tag.
2782

            
2783
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2784

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2787
L<DBIx::Custom> is stable. APIs keep backword compatible
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2788
except EXPERIMENTAL one in the feature.
DBIx::Custom is now stable
yuki-kimoto authored on 2010-09-07
2789

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

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

            
2794
C<< <kimoto.yuki at gmail.com> >>
2795

            
2796
L<http://github.com/yuki-kimoto/DBIx-Custom>
2797

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2798
=head1 AUTHOR
2799

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2804
Copyright 2009-2011 Yuki Kimoto, all rights reserved.
packaging one directory
yuki-kimoto authored on 2009-11-16
2805

            
2806
This program is free software; you can redistribute it and/or modify it
2807
under the same terms as Perl itself.
2808

            
2809
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2810

            
2811