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

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
3
our $VERSION = '0.1661';
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

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

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

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

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

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

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

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

            
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
143
sub method {
added helper method
yuki-kimoto authored on 2010-10-17
144
    my $self = shift;
145
    
146
    # Merge
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
147
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
148
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
added helper method
yuki-kimoto authored on 2010-10-17
149
    
150
    return $self;
151
}
152

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
217
sub dbh {
218
    my $self = shift;
219

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

            
cleanup
yuki-kimoto authored on 2010-10-17
240
our %VALID_DELETE_ARGS
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
241
  = map { $_ => 1 } qw/table where append filter allow_delete_all query/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
242

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

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
260
    # Where
261
    my $w;
262
    if (ref $where eq 'HASH') {
263
        my $clause = ['and'];
264
        push @$clause, "{= $_}" for keys %$where;
265
        $w = $self->where;
266
        $w->clause($clause);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
267
        $w->param($where);
packaging one directory
yuki-kimoto authored on 2009-11-16
268
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
269
    elsif (ref $where eq 'DBIx::Custom::Where') {
270
        $w = $where;
271
        $where = $w->param;
272
    }    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
273
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
274
      unless ref $w eq 'DBIx::Custom::Where';
275
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
276
    # String where
277
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
278
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
279
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
280
      if $swhere eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
281

            
cleanup
Yuki Kimoto authored on 2011-01-27
282
    # SQL stack
283
    my @sql;
284

            
285
    # Delete
286
    push @sql, "delete from $table $swhere";
287
    push @sql, $append if $append;
288
    
289
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
290
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
291
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
292
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
293
    return $query if $args{query};
294
    
packaging one directory
yuki-kimoto authored on 2009-11-16
295
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
296
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
297
        $query, param  => $where, filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
298
        table => $table);
packaging one directory
yuki-kimoto authored on 2009-11-16
299
    
300
    return $ret_val;
301
}
302

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
305
our %VALID_DELETE_AT_ARGS
update pod
Yuki Kimoto authored on 2011-03-13
306
  = map { $_ => 1 } qw/table where append filter query primary_key param/;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
307

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
346
sub DESTROY { }
347

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
348
our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter table/;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
349

            
cleanup
yuki-kimoto authored on 2010-10-17
350
sub execute{
351
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
352
    
cleanup
Yuki Kimoto authored on 2011-03-09
353
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
354
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
355
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
356
          unless $VALID_EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
357
    }
358
    
cleanup
yuki-kimoto authored on 2010-10-17
359
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
360
    
cleanup
yuki-kimoto authored on 2010-10-17
361
    # First argument is the soruce of SQL
362
    $query = $self->create_query($query)
363
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
364
    
add table tag
Yuki Kimoto authored on 2011-02-09
365
    # Applied filter
cleanup
Yuki Kimoto authored on 2011-01-12
366
    my $filter = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
367
    
add table tag
Yuki Kimoto authored on 2011-02-09
368
    my $tables = $query->tables;
369
    my $arg_tables = $args{table} || [];
370
    $arg_tables = [$arg_tables]
371
      unless ref $arg_tables eq 'ARRAY';
372
    push @$tables, @$arg_tables;
cleanup
Yuki Kimoto authored on 2011-03-09
373

            
374
    # Organize tables
375
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
376
    my $main_table = pop @$tables;
377
    delete $table_set{$main_table} if $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
378
    foreach my $table (keys %table_set) {
379
        push @$tables, $table;
380
        
381
        if (my $dist = $self->{_table_alias}->{$table}) {
382
            $self->{filter} ||= {};
383
            
384
            unless ($self->{filter}{out}{$table}) {
385
                $self->{filter}{out} ||= {};
386
                $self->{filter}{in}  ||= {};
387
                $self->{filter}{end} ||= {};
388
                
389
                foreach my $type (qw/out in end/) {
390
                    
391
                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {
392
                        my $filter_name_alias = $filter_name;
393
                        $filter_name_alias =~ s/^$dist\./$table\./;
394
                        $filter_name_alias =~ s/^${dist}__/${table}__/; 
395
                        
396
                        $self->{filter}{$type}{$table}{$filter_name_alias}
397
                          = $self->{filter}{$type}{$dist}{$filter_name}
398
                    }
399
                }
400
            }
401
        }
402
    }
403
    
cleanup
Yuki Kimoto authored on 2011-03-09
404
    $tables = [keys %table_set];
405
    push @$tables, $main_table if $main_table;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
406
    
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
407
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
408
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
409
        $filter = {
410
            %$filter,
411
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
412
        }
413
    }
414
    
cleanup
Yuki Kimoto authored on 2011-01-12
415
    # Filter argument
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
416
    my $f = DBIx::Custom::Util::array_filter_to_hash($args{filter})
417
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
418
    foreach my $column (keys %$f) {
419
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
420
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
421
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
422
        }
423
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
424
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
425
            unless exists $self->filters->{$fname};
426
          
cleanup
Yuki Kimoto authored on 2011-01-12
427
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
428
        }
429
    }
cleanup
Yuki Kimoto authored on 2011-01-12
430
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
431
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
432
    # Bind
433
    my $bind = $self->_bind($params, $query->columns, $filter);
cleanup
yuki-kimoto authored on 2010-10-17
434
    
435
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
436
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
437
    my $affected;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
438
    eval {$affected = $sth->execute(@$bind)};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
439
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
440
    
441
    # Return resultset if select statement is executed
442
    if ($sth->{NUM_OF_FIELDS}) {
443
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
444
        # Result in and end filter
445
        my $in_filter  = {};
446
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
447
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
448
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
449
            $in_filter = {
450
                %$in_filter,
451
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
452
            };
453
            $end_filter = {
454
                %$end_filter,
455
                %{$self->{filter}{end}{$table} || {}}
456
            };
cleanup
Yuki Kimoto authored on 2011-01-12
457
        }
458
        
459
        # Result
460
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
461
            sth            => $sth,
462
            filters        => $self->filters,
463
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
464
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
465
            filter         => $in_filter || {},
466
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
467
        );
468

            
469
        return $result;
470
    }
471
    return $affected;
472
}
473

            
update pod
Yuki Kimoto authored on 2011-03-13
474
our %VALID_INSERT_ARGS
475
  = map { $_ => 1 } qw/table param append filter query/;
476

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
480
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
481
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
482
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
483
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
484
    }
485
    
cleanup
yuki-kimoto authored on 2010-10-17
486
    # Arguments
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
487
    my $table  = $args{table};
488
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
489
    my $param  = $args{param} || {};
490
    my $append = $args{append} || '';
491
    my $filter = $args{filter};
492
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
493
    # Columns
494
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
495
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
496
    foreach my $column (keys %$param) {
497
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
498
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
499
        push @columns, $column;
500
    }
cleanup
yuki-kimoto authored on 2010-10-17
501
    
cleanup
Yuki Kimoto authored on 2011-01-27
502
    # SQL stack
503
    my @sql;
504
    
505
    # Insert
506
    push @sql, "insert into $table {insert_param ". join(' ', @columns) . '}';
507
    push @sql, $append if $append;
508
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
509
    # SQL
cleanup
Yuki Kimoto authored on 2011-01-27
510
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
511
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
512
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
513
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
514
    return $query if $args{query};
515
    
packaging one directory
yuki-kimoto authored on 2009-11-16
516
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
517
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
518
        $query,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
519
        param  => $param,
520
        filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
521
        table => $table
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
522
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
523
    
524
    return $ret_val;
525
}
526

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
527
our %VALID_INSERT_AT_ARGS
update pod
Yuki Kimoto authored on 2011-03-13
528
  = map { $_ => 1 } qw/table param where append filter
529
                       query primary_key param/;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
530

            
531
sub insert_at {
532
    my ($self, %args) = @_;
533
    
cleanup
Yuki Kimoto authored on 2011-03-09
534
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
535
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
536
        croak qq{Argument "$name" is invalid name}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
537
          unless $VALID_INSERT_AT_ARGS{$name};
538
    }
539
    
540
    # Primary key
541
    my $primary_keys = delete $args{primary_key};
542
    $primary_keys = [$primary_keys] unless ref $primary_keys;
543
    
544
    # Where clause
545
    my $where = {};
546
    my $param = {};
547
    
548
    if (exists $args{where}) {
549
        my $where_columns = delete $args{where};
550
        $where_columns = [$where_columns] unless ref $where_columns;
551

            
552
        croak qq{"where" must be constant value or array reference}
553
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
554
        
555
        for(my $i = 0; $i < @$primary_keys; $i ++) {
556
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
557
        }
558
    }
559
    
560
    if (exists $args{param}) {
561
        $param = delete $args{param};
562
        for(my $i = 0; $i < @$primary_keys; $i ++) {
563
             delete $param->{$primary_keys->[$i]};
564
        }
565
    }
566
    
567
    $param = {%$param, %$where};
568
    
569
    return $self->insert(param => $param, %args);
570
}
571

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
572
sub insert_param {
573
    my ($self, $param) = @_;
574
    
update pod
Yuki Kimoto authored on 2011-03-13
575
    # Insert parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
576
    my @tag;
577
    push @tag, '{insert_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
578
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
579
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
580
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
581
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
582
        push @tag, $column;
583
    }
584
    push @tag, '}';
585
    
586
    return join ' ', @tag;
587
}
588

            
pod fix
Yuki Kimoto authored on 2011-01-21
589
sub each_column {
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
590
    my ($self, $cb) = @_;
591
    
592
    # Iterate all tables
593
    my $sth_tables = $self->dbh->table_info;
594
    while (my $table_info = $sth_tables->fetchrow_hashref) {
595
        
596
        # Table
597
        my $table = $table_info->{TABLE_NAME};
598
        
599
        # Iterate all columns
600
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
601
        while (my $column_info = $sth_columns->fetchrow_hashref) {
602
            my $column = $column_info->{COLUMN_NAME};
removed experimental txn_sco...
Yuki Kimoto authored on 2011-01-24
603
            $self->$cb($table, $column, $column_info);
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
604
        }
605
    }
606
}
607

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
608
sub include_model {
609
    my ($self, $name_space, $model_infos) = @_;
610
    
611
    $name_space ||= '';
612
    unless ($model_infos) {
613
        # Load name space module
614
        croak qq{"$name_space" is invalid class name}
615
          if $name_space =~ /[^\w:]/;
616
        eval "use $name_space";
617
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
618
        
619
        # Search model modules
620
        my $path = $INC{"$name_space.pm"};
621
        $path =~ s/\.pm$//;
622
        opendir my $dh, $path
623
          or croak qq{Can't open directory "$path": $!};
624
        $model_infos = [];
625
        while (my $module = readdir $dh) {
626
            push @$model_infos, $module
627
              if $module =~ s/\.pm$//;
628
        }
629
        
630
        close $dh;
631
    }
632
    
633
    my $table_alias = {};
634
    foreach my $model_info (@$model_infos) {
635
        
636
        # Model class, name, table
637
        my $model_class;
638
        my $model_name;
639
        my $model_table;
640
        if (ref $model_info eq 'HASH') {
641
            $model_class = $model_info->{class};
642
            $model_name  = $model_info->{name};
643
            $model_table = $model_info->{table};
644
            
645
            $model_name  ||= $model_class;
646
            $model_table ||= $model_name;
647
        }
648
        else { $model_class =$model_name = $model_table = $model_info }
649
        my $mclass = "${name_space}::$model_class";
650
        
651
        # Load
652
        croak qq{"$mclass" is invalid class name}
653
          if $mclass =~ /[^\w:]/;
654
        unless ($mclass->can('isa')) {
655
            eval "use $mclass";
656
            croak $@ if $@;
657
        }
658
        
659
        # Instantiate
660
        my $model = $mclass->new(dbi => $self);
661
        $model->name($model_name) unless $model->name;
662
        $model->table($model_table) unless $model->table;
663
        
664
        # Set
665
        $self->model($model->name, $model);
666
        
667
        # Apply filter
668
        croak "${name_space}::$model_class filter must be array reference"
669
          unless ref $model->filter eq 'ARRAY';
670
        $self->apply_filter($model->table, @{$model->filter});
671
        
672
        # Table alias
673
        $table_alias = {%$table_alias, %{$model->table_alias}};
674
        
675
        # Table - Model
676
        $self->{_model_from}->{$model->table} = $model->name;
677
    }
678
    
679
    $self->{_table_alias} = $table_alias;
680
    
681
    return $self;
682
}
683

            
684
sub model {
685
    my ($self, $name, $model) = @_;
686
    
687
    # Set
688
    if ($model) {
689
        $self->models->{$name} = $model;
690
        return $self;
691
    }
692
    
693
    # Check model existance
694
    croak qq{Model "$name" is not included}
695
      unless $self->models->{$name};
696
    
697
    # Get
698
    return $self->models->{$name};
699
}
700

            
added dbi_options attribute
kimoto authored on 2010-12-20
701
sub new {
702
    my $self = shift->SUPER::new(@_);
703
    
704
    # Check attribute names
705
    my @attrs = keys %$self;
706
    foreach my $attr (@attrs) {
707
        croak qq{"$attr" is invalid attribute name}
708
          unless $self->can($attr);
709
    }
cleanup
Yuki Kimoto authored on 2011-01-25
710

            
711
    $self->register_tag(
712
        '?'     => \&DBIx::Custom::Tag::placeholder,
713
        '='     => \&DBIx::Custom::Tag::equal,
714
        '<>'    => \&DBIx::Custom::Tag::not_equal,
715
        '>'     => \&DBIx::Custom::Tag::greater_than,
716
        '<'     => \&DBIx::Custom::Tag::lower_than,
717
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
718
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
719
        'like'  => \&DBIx::Custom::Tag::like,
720
        'in'    => \&DBIx::Custom::Tag::in,
721
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
722
        'update_param' => \&DBIx::Custom::Tag::update_param
723
    );
added dbi_options attribute
kimoto authored on 2010-12-20
724
    
725
    return $self;
726
}
727

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

            
cleanup
yuki-kimoto authored on 2010-10-17
730
sub register_filter {
731
    my $invocant = shift;
732
    
733
    # Register filter
734
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
735
    $invocant->filters({%{$invocant->filters}, %$filters});
736
    
737
    return $invocant;
738
}
packaging one directory
yuki-kimoto authored on 2009-11-16
739

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
742
our %VALID_SELECT_ARGS
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
743
  = map { $_ => 1 } qw/table column where append relation filter query
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
744
                       selection join/;
refactoring select
yuki-kimoto authored on 2010-04-28
745

            
packaging one directory
yuki-kimoto authored on 2009-11-16
746
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
747
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
748
    
cleanup
Yuki Kimoto authored on 2011-03-09
749
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
750
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
751
        croak qq{Argument "$name" is invalid name}
refactoring select
yuki-kimoto authored on 2010-04-28
752
          unless $VALID_SELECT_ARGS{$name};
753
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
754
    
refactoring select
yuki-kimoto authored on 2010-04-28
755
    # Arguments
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
756
    my $table = $args{table};
757
    my $tables = ref $table eq 'ARRAY' ? $table
758
               : defined $table ? [$table]
759
               : [];
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
760
    my $columns   = $args{column};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
761
    my $selection = $args{selection} || '';
762
    my $where     = $args{where} || {};
763
    my $append    = $args{append};
764
    my $filter    = $args{filter};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
765
    my $join =     $args{join} || [];
766
    croak qq{"join" must be array reference}
767
      unless ref $join eq 'ARRAY';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
768
    
cleanup
Yuki Kimoto authored on 2011-03-09
769
    # Add relation tables(DEPRECATED!);
770
    $self->_add_relation_table($tables, $args{relation});
packaging one directory
yuki-kimoto authored on 2009-11-16
771
    
cleanup
Yuki Kimoto authored on 2011-01-27
772
    # SQL stack
773
    my @sql;
774
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
775
    
cleanup
Yuki Kimoto authored on 2011-03-09
776
    # Selection
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
777
    if ($selection) { 
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
778
        push @sql, $selection;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
779
        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {
780
             unshift @$tables, $1;
781
        }
782
        unshift @$tables, @{$self->_tables($selection)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
783
    }
cleanup
Yuki Kimoto authored on 2011-03-09
784
    
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
785
    # Column clause
786
    elsif ($columns) {
787

            
788
        $columns = [$columns] if ! ref $columns;
789
        
790
        if (ref $columns eq 'HASH') {
791
            # Find tables
792
            my $main_table;
793
            my %tables;
794
            if ($columns->{table}) {
795
                foreach my $table (@{$columns->{table}}) {
796
                    if (($table || '') eq $tables->[-1]) {
797
                        $main_table = $table;
798
                    }
799
                    else {
800
                        $tables{$table} = 1;
801
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
802
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
803
            }
804
            elsif ($columns->{all}) {
805
                $main_table = $tables->[-1] || '';
806
                foreach my $j (@$join) {
807
                    my $tables = $self->_tables($j);
808
                    foreach my $table (@$tables) {
809
                        $tables{$table} = 1;
810
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
811
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
812
                delete $tables{$main_table};
813
            }
814
            
815
            push @sql, $columns->{prepend} if $columns->{prepend};
816
            
817
            # Column clause of main table
818
            if ($main_table) {
819
                push @sql, $self->model($main_table)->column_clause;
820
                push @sql, ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
821
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
822
            
823
            # Column cluase of other tables
824
            foreach my $table (keys %tables) {
825
                unshift @$tables, $table;
826
                push @sql, $self->model($table)
827
                                ->column_clause(prefix => "${table}__");
828
                push @sql, ',';
829
            }
830
            pop @sql if $sql[-1] eq ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
831
        }
832
        else {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
833
            foreach my $column (@$columns) {
834
                unshift @$tables, @{$self->_tables($column)};
835
                push @sql, ($column, ',');
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
836
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
837
            pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
838
        }
839
    }
840
    
841
    # "*" is default
842
    else { push @sql, '*' }
843
    
844
    # Table
845
    unless ($selection) {
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
846
        push @sql, 'from';
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
847
        if ($args{relation}) {
848
            my $found = {};
849
            foreach my $table (@$tables) {
850
                push @sql, ($table, ',') unless $found->{$table};
851
                $found->{$table} = 1;
852
            }
packaging one directory
yuki-kimoto authored on 2009-11-16
853
        }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
854
        else {
855
            my $main_table = $tables->[-1] || '';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
856
            push @sql, $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
857
        }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
858
        pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
859
    }
860
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
861
    # Main table
862
    croak "Not found table name" unless $tables->[-1];
863
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
864
    # Where
865
    my $w;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
866
    if (ref $where eq 'HASH') {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
867
        my $clause = ['and'];
868
        push @$clause, "{= $_}" for keys %$where;
cleanup
Yuki Kimoto authored on 2011-03-09
869
        $w = $self->where(clause => $clause, param => $where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
870
    }
871
    elsif (ref $where eq 'DBIx::Custom::Where') {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
872
        $w = $where;
873
        $where = $w->param;
packaging one directory
yuki-kimoto authored on 2009-11-16
874
    }
875
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
876
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
877
      unless ref $w eq 'DBIx::Custom::Where';
878
    
879
    # String where
880
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
881
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
882
    # Add table names in where clause
883
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
884
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
885
    # Push join
886
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
887
    
cleanup
Yuki Kimoto authored on 2011-03-09
888
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
889
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
890
    
cleanup
Yuki Kimoto authored on 2011-03-08
891
    # Relation(DEPRECATED!);
892
    $self->_push_relation(\@sql, $tables, $args{relation}, $swhere eq '' ? 1 : 0);
893
    
cleanup
Yuki Kimoto authored on 2011-01-27
894
    # Append statement
895
    push @sql, $append if $append;
896
    
897
    # SQL
898
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
899
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
900
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
901
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
902
    return $query if $args{query};
903
    
packaging one directory
yuki-kimoto authored on 2009-11-16
904
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
905
    my $result = $self->execute(
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
906
        $query, param  => $where, filter => $filter,
907
        table => $tables);
packaging one directory
yuki-kimoto authored on 2009-11-16
908
    
909
    return $result;
910
}
911

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
912
our %VALID_SELECT_AT_ARGS
913
  = map { $_ => 1 } qw/table column where append relation filter query selection
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
914
                       param primary_key join/;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
915

            
916
sub select_at {
917
    my ($self, %args) = @_;
918
    
cleanup
Yuki Kimoto authored on 2011-03-09
919
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
920
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
921
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
922
          unless $VALID_SELECT_AT_ARGS{$name};
923
    }
924
    
925
    # Primary key
926
    my $primary_keys = delete $args{primary_key};
927
    $primary_keys = [$primary_keys] unless ref $primary_keys;
928
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
929
    # Table
930
    croak qq{"table" option must be specified} unless $args{table};
931
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
932
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
933
    # Where clause
934
    my $where = {};
935
    if (exists $args{where}) {
936
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
937
        
938
        croak qq{"where" must be constant value or array reference}
939
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
940
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
941
        $where_columns = [$where_columns] unless ref $where_columns;
942
        
943
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
944
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
945
        }
946
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
947
    
948
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
949
        my $param = delete $args{param};
950
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
951
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
952
        }
953
    }
954
    
955
    return $self->select(where => $where, %args);
956
}
957

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
958
sub setup_model {
959
    my $self = shift;
960
    
961
    $self->each_column(
962
        sub {
963
            my ($self, $table, $column, $column_info) = @_;
964
            
965
            if (my $model = $self->models->{$table}) {
966
                push @{$model->columns}, $column;
967
            }
968
        }
969
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
970
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
971
}
972

            
cleanup
yuki-kimoto authored on 2010-10-17
973
our %VALID_UPDATE_ARGS
update pod
Yuki Kimoto authored on 2011-03-13
974
  = map { $_ => 1 } qw/table param where append filter
975
                       allow_update_all query/;
cleanup
yuki-kimoto authored on 2010-10-17
976

            
977
sub update {
978
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
979
    
cleanup
Yuki Kimoto authored on 2011-03-09
980
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
981
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
982
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
983
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
984
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
985
    
cleanup
yuki-kimoto authored on 2010-10-17
986
    # Arguments
987
    my $table            = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
988
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
989
    my $param            = $args{param} || {};
990
    my $where            = $args{where} || {};
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
991
    my $append           = $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
992
    my $filter           = $args{filter};
993
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
994
    
cleanup
yuki-kimoto authored on 2010-10-17
995
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
996
    my @clumns = keys %$param;
997

            
998
    # Columns
999
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1000
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1001
    foreach my $column (keys %$param) {
1002
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1003
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1004
        push @columns, $column;
1005
    }
1006
        
cleanup
yuki-kimoto authored on 2010-10-17
1007
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1008
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1009

            
1010
    # Where
1011
    my $w;
1012
    if (ref $where eq 'HASH') {
1013
        my $clause = ['and'];
1014
        push @$clause, "{= $_}" for keys %$where;
1015
        $w = $self->where;
1016
        $w->clause($clause);
1017
        $w->param($where);
1018
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1019
    elsif (ref $where eq 'DBIx::Custom::Where') {
1020
        $w = $where;
1021
        $where = $w->param;
1022
    }  
removed experimental registe...
yuki-kimoto authored on 2010-08-24
1023
    
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1024
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
1025
      unless ref $w eq 'DBIx::Custom::Where';
removed reconnect method
yuki-kimoto authored on 2010-05-28
1026
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1027
    # String where
1028
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1029
    
1030
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1031
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1032
    
cleanup
Yuki Kimoto authored on 2011-01-27
1033
    # SQL stack
1034
    my @sql;
1035
    
1036
    # Update
1037
    push @sql, "update $table $update_clause $swhere";
1038
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1039
    
cleanup
yuki-kimoto authored on 2010-10-17
1040
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1041
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1042
        
cleanup
yuki-kimoto authored on 2010-10-17
1043
        if (exists $param->{$wkey}) {
1044
            $param->{$wkey} = [$param->{$wkey}]
1045
              unless ref $param->{$wkey} eq 'ARRAY';
1046
            
1047
            push @{$param->{$wkey}}, $where->{$wkey};
1048
        }
1049
        else {
1050
            $param->{$wkey} = $where->{$wkey};
1051
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1052
    }
cleanup
yuki-kimoto authored on 2010-10-17
1053
    
cleanup
Yuki Kimoto authored on 2011-01-27
1054
    # SQL
1055
    my $sql = join(' ', @sql);
1056
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1057
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1058
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1059
    return $query if $args{query};
1060
    
cleanup
yuki-kimoto authored on 2010-10-17
1061
    # Execute query
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1062
    my $ret_val = $self->execute($query, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1063
                                 filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1064
                                 table => $table);
cleanup
yuki-kimoto authored on 2010-10-17
1065
    
1066
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1067
}
1068

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1071
our %VALID_UPDATE_AT_ARGS
update pod
Yuki Kimoto authored on 2011-03-13
1072
  = map { $_ => 1 } qw/table param where append filter
1073
                       query primary_key param/;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1074

            
1075
sub update_at {
1076
    my ($self, %args) = @_;
1077
    
cleanup
Yuki Kimoto authored on 2011-03-09
1078
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1079
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1080
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1081
          unless $VALID_UPDATE_AT_ARGS{$name};
1082
    }
1083
    
1084
    # Primary key
1085
    my $primary_keys = delete $args{primary_key};
1086
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1087
    
1088
    # Where clause
1089
    my $where = {};
1090
    my $param = {};
1091
    
1092
    if (exists $args{where}) {
1093
        my $where_columns = delete $args{where};
1094
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1095

            
1096
        croak qq{"where" must be constant value or array reference}
1097
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1098
        
1099
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1100
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1101
        }
1102
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1103
    
1104
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1105
        $param = delete $args{param};
1106
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1107
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1108
        }
1109
    }
1110
    
1111
    return $self->update(where => $where, param => $param, %args);
1112
}
1113

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1114
sub update_param {
1115
    my ($self, $param) = @_;
1116
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1117
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1118
    my @tag;
1119
    push @tag, '{update_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1120
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1121
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1122
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1123
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1124
        push @tag, $column;
1125
    }
1126
    push @tag, '}';
1127
    
1128
    return join ' ', @tag;
1129
}
1130

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

            
1134
    return DBIx::Custom::Where->new(
1135
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1136
        safety_character => $self->safety_character,
cleanup
Yuki Kimoto authored on 2011-03-09
1137
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1138
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1139
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1140

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1141
sub _bind {
cleanup
Yuki Kimoto authored on 2011-01-12
1142
    my ($self, $params, $columns, $filter) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1143
    
cleanup
Yuki Kimoto authored on 2011-01-12
1144
    # bind values
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1145
    my @bind;
add tests
yuki-kimoto authored on 2010-08-08
1146
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1147
    # Build bind values
1148
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1149
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1150
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1151
        
1152
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1153
        my $value;
1154
        if(ref $params->{$column} eq 'ARRAY') {
1155
            my $i = $count->{$column} || 0;
1156
            $i += $not_exists->{$column} || 0;
1157
            my $found;
1158
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1159
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1160
                    $not_exists->{$column}++;
1161
                }
1162
                else  {
1163
                    $value = $params->{$column}->[$k];
1164
                    $found = 1;
1165
                    last
1166
                }
1167
            }
1168
            next unless $found;
1169
        }
1170
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1171
        
cleanup
Yuki Kimoto authored on 2011-01-12
1172
        # Filter
1173
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1174
        
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1175
        push @bind, $f ? $f->($value) : $value;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1176
        
1177
        # Count up 
1178
        $count->{$column}++;
1179
    }
1180
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1181
    return \@bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1182
}
1183

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1184
sub _connect {
1185
    my $self = shift;
1186
    
1187
    # Attributes
1188
    my $data_source = $self->data_source;
1189
    croak qq{"data_source" must be specified to connect()"}
1190
      unless $data_source;
1191
    my $user        = $self->user;
1192
    my $password    = $self->password;
1193
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1194
    
1195
    # Connect
1196
    my $dbh = eval {DBI->connect(
1197
        $data_source,
1198
        $user,
1199
        $password,
1200
        {
1201
            %{$self->default_dbi_option},
1202
            %$dbi_option
1203
        }
1204
    )};
1205
    
1206
    # Connect error
1207
    croak $@ if $@;
1208
    
1209
    return $dbh;
1210
}
1211

            
cleanup
yuki-kimoto authored on 2010-10-17
1212
sub _croak {
1213
    my ($self, $error, $append) = @_;
1214
    $append ||= "";
1215
    
1216
    # Verbose
1217
    if ($Carp::Verbose) { croak $error }
1218
    
1219
    # Not verbose
1220
    else {
1221
        
1222
        # Remove line and module infromation
1223
        my $at_pos = rindex($error, ' at ');
1224
        $error = substr($error, 0, $at_pos);
1225
        $error =~ s/\s+$//;
1226
        
1227
        croak "$error$append";
1228
    }
1229
}
1230

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1231
sub _need_tables {
1232
    my ($self, $tree, $need_tables, $tables) = @_;
1233
    
1234
    foreach my $table (@$tables) {
1235
        
1236
        if ($tree->{$table}) {
1237
            $need_tables->{$table} = 1;
1238
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1239
        }
1240
    }
1241
}
1242

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1243
sub _tables {
1244
    my ($self, $source) = @_;
1245
    
1246
    my $tables = [];
1247
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1248
    my $safety_character = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1249
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1250
    while ($source =~ /\b($safety_character+)\./g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1251
        push @$tables, $1;
1252
    }
1253
    
1254
    return $tables;
1255
}
1256

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1257
sub _push_join {
1258
    my ($self, $sql, $join, $join_tables) = @_;
1259
    
1260
    return unless @$join;
1261
    
1262
    my $tree = {};
1263
    
1264
    for (my $i = 0; $i < @$join; $i++) {
1265
        
1266
        my $join_clause = $join->[$i];
1267
        
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
1268
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1269
            
1270
            my $table1 = $1;
1271
            my $table2 = $2;
1272
            
1273
            croak qq{right side table of "$join_clause" must be uniq}
1274
              if exists $tree->{$table2};
1275
            
1276
            $tree->{$table2}
1277
              = {position => $i, parent => $table1, join => $join_clause};
1278
        }
1279
        else {
1280
            croak qq{join "$join_clause" must be two table name};
1281
        }
1282
    }
1283
    
1284
    my $need_tables = {};
1285
    $self->_need_tables($tree, $need_tables, $join_tables);
1286
    
1287
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1288

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1289
    foreach my $need_table (@need_tables) {
1290
        push @$sql, $tree->{$need_table}{join};
1291
    }
1292
}
cleanup
Yuki Kimoto authored on 2011-03-08
1293

            
cleanup
Yuki Kimoto authored on 2011-01-25
1294
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1295
__PACKAGE__->attr(
1296
    dbi_options => sub { {} },
1297
    filter_check  => 1
1298
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1299

            
cleanup
Yuki Kimoto authored on 2011-01-25
1300
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1301
sub default_bind_filter {
1302
    my $self = shift;
1303
    
1304
    if (@_) {
1305
        my $fname = $_[0];
1306
        
1307
        if (@_ && !$fname) {
1308
            $self->{default_out_filter} = undef;
1309
        }
1310
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1311
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1312
              unless exists $self->filters->{$fname};
1313
        
1314
            $self->{default_out_filter} = $self->filters->{$fname};
1315
        }
1316
        return $self;
1317
    }
1318
    
1319
    return $self->{default_out_filter};
1320
}
1321

            
cleanup
Yuki Kimoto authored on 2011-01-25
1322
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1323
sub default_fetch_filter {
1324
    my $self = shift;
1325
    
1326
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1327
        my $fname = $_[0];
1328

            
cleanup
Yuki Kimoto authored on 2011-01-12
1329
        if (@_ && !$fname) {
1330
            $self->{default_in_filter} = undef;
1331
        }
1332
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1333
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1334
              unless exists $self->filters->{$fname};
1335
        
1336
            $self->{default_in_filter} = $self->filters->{$fname};
1337
        }
1338
        
1339
        return $self;
1340
    }
1341
    
many changed
Yuki Kimoto authored on 2011-01-23
1342
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1343
}
1344

            
cleanup
Yuki Kimoto authored on 2011-01-25
1345
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1346
sub register_tag_processor {
1347
    return shift->query_builder->register_tag_processor(@_);
1348
}
1349

            
cleanup
Yuki Kimoto authored on 2011-03-08
1350
# DEPRECATED!
1351
sub _push_relation {
1352
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1353
    
1354
    if (keys %{$relation || {}}) {
1355
        push @$sql, $need_where ? 'where' : 'and';
1356
        foreach my $rcolumn (keys %$relation) {
1357
            my $table1 = (split (/\./, $rcolumn))[0];
1358
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1359
            push @$tables, ($table1, $table2);
1360
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1361
        }
1362
    }
1363
    pop @$sql if $sql->[-1] eq 'and';    
1364
}
1365

            
1366
# DEPRECATED!
1367
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1368
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1369
    
1370
    if (keys %{$relation || {}}) {
1371
        foreach my $rcolumn (keys %$relation) {
1372
            my $table1 = (split (/\./, $rcolumn))[0];
1373
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1374
            my $table1_exists;
1375
            my $table2_exists;
1376
            foreach my $table (@$tables) {
1377
                $table1_exists = 1 if $table eq $table1;
1378
                $table2_exists = 1 if $table eq $table2;
1379
            }
1380
            unshift @$tables, $table1 unless $table1_exists;
1381
            unshift @$tables, $table2 unless $table2_exists;
1382
        }
1383
    }
1384
}
1385

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1388
=head1 NAME
1389

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

            
1392
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1393

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1394
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1395
    
1396
    # Connect
1397
    my $dbi = DBIx::Custom->connect(
1398
        data_source => "dbi:mysql:database=dbname",
1399
        user => 'ken',
1400
        password => '!LFKD%$&',
1401
        dbi_option => {mysql_enable_utf8 => 1}
1402
    );
cleanup
yuki-kimoto authored on 2010-08-05
1403

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1404
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1405
    $dbi->insert(
1406
        table  => 'book',
1407
        param  => {title => 'Perl', author => 'Ken'}
1408
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1409
    
1410
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1411
    $dbi->update(
1412
        table  => 'book', 
1413
        param  => {title => 'Perl', author => 'Ken'}, 
1414
        where  => {id => 5},
1415
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1416
    
1417
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1418
    $dbi->delete(
1419
        table  => 'book',
1420
        where  => {author => 'Ken'},
1421
    );
cleanup
yuki-kimoto authored on 2010-08-05
1422

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1429
    # Select, more complex
1430
    my $result = $dbi->select(
1431
        table  => 'book',
1432
        column => [
1433
            'book.author as book__author',
1434
            'company.name as company__name'
1435
        ],
1436
        where  => {'book.author' => 'Ken'},
1437
        join => ['left outer join company on book.company_id = company.id'],
1438
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1439
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1440
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1441
    # Fetch
1442
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1443
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1444
    }
1445
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1446
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1447
    while (my $row = $result->fetch_hash) {
1448
        
1449
    }
1450
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1451
    # Execute SQL with parameter.
1452
    $dbi->execute(
1453
        "select id from book where {= author} and {like title}",
1454
        param  => {author => 'ken', title => '%Perl%'}
1455
    );
1456
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1457
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1458

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

            
1461
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1462

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1467
There are many basic methods to execute various queries.
1468
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1469
C<delete_all()>, C<select()>,
1470
C<insert_at()>, C<update_at()>, 
1471
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1472

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1473
=item *
1474

            
1475
Filter when data is send or receive.
1476

            
1477
=item *
1478

            
1479
Data filtering system
1480

            
1481
=item *
1482

            
1483
Model support.
1484

            
1485
=item *
1486

            
1487
Generate where clause dinamically.
1488

            
1489
=item *
1490

            
1491
Generate join clause dinamically.
1492

            
1493
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1494

            
1495
=head1 GUIDE
1496

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1528
=head2 C<default_dbi_option>
1529

            
1530
    my $default_dbi_option = $dbi->default_dbi_option;
1531
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1532

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1536
    {
1537
        RaiseError => 1,
1538
        PrintError => 0,
1539
        AutoCommit => 1,
1540
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1541

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

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

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

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

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

            
1554
    my $models = $dbi->models;
1555
    $dbi       = $dbi->models(\%models);
1556

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1559
=head2 C<password>
1560

            
1561
    my $password = $dbi->password;
1562
    $dbi         = $dbi->password('lkj&le`@s');
1563

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1580
=head2 C<safety_character> EXPERIMENTAL
update pod
Yuki Kimoto authored on 2011-01-27
1581

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1590
    my $user = $dbi->user;
1591
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1592

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1603
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1604
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1605
        'issue_date' => {
1606
            out => 'tp_to_date',
1607
            in  => 'date_to_tp',
1608
            end => 'tp_to_displaydate'
1609
        },
1610
        'write_date' => {
1611
            out => 'tp_to_date',
1612
            in  => 'date_to_tp',
1613
            end => 'tp_to_displaydate'
1614
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1615
    );
1616

            
update pod
Yuki Kimoto authored on 2011-03-13
1617
Apply filter to columns.
1618
C<out> filter is executed before data is send to database.
1619
C<in> filter is executed after a row is fetch.
1620
C<end> filter is execute after C<in> filter is executed.
1621

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1624
       PETTERN         EXAMPLE
1625
    1. Column        : author
1626
    2. Table.Column  : book.author
1627
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1628

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

            
1632
You can set multiple filters at once.
1633

            
1634
    $dbi->apply_filter(
1635
        'book',
1636
        [qw/issue_date write_date/] => {
1637
            out => 'tp_to_date',
1638
            in  => 'date_to_tp',
1639
            end => 'tp_to_displaydate'
1640
        }
1641
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1642

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

            
1645
    $dbi          = $dbi->cache_method(\&cache_method);
1646
    $cache_method = $dbi->cache_method
1647

            
update pod
Yuki Kimoto authored on 2011-03-13
1648
Method to set and get cache.
1649
Default to the following one.
1650

            
1651
    sub {
1652
        my $self = shift;
1653
        
1654
        $self->{_cached} ||= {};
1655
        
1656
        if (@_ > 1) {
1657
            $self->{_cached}{$_[0]} = $_[1];
1658
        }
1659
        else {
1660
            return $self->{_cached}{$_[0]};
1661
        }
1662
    }
update pod
Yuki Kimoto authored on 2011-03-13
1663

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1666
    my $dbi = DBIx::Custom->connect(
1667
        data_source => "dbi:mysql:database=dbname",
1668
        user => 'ken',
1669
        password => '!LFKD%$&',
1670
        dbi_option => {mysql_enable_utf8 => 1}
1671
    );
1672

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1679
=head2 C<create_query>
1680
    
1681
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1682
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1683
    );
update document
yuki-kimoto authored on 2009-11-19
1684

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

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

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

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

            
1695
    my $dbh = $dbi->dbh;
1696
    $dbi    = $dbi->dbh($dbh);
1697

            
1698
Get and set database handle of L<DBI>.
1699

            
update pod
Yuki Kimoto authored on 2011-03-13
1700
If process is spawn by forking, new connection is created automatically.
1701
This feature is EXPERIMETNAL.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1702

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1705
    my $result = $dbi->execute(
1706
        "select * from book where {= title} and {like author}",
1707
        param => {title => 'Perl', author => '%Ken%'}
1708
    );
1709

            
1710
Execute SQL, containing tags.
1711
Return value is L<DBIx::Custom::Result> in select statement, or
1712
the count of affected rows in insert, update, delete statement.
1713

            
1714
Tag is turned into the statement containing place holder
1715
before SQL is executed.
1716

            
1717
    select * from where title = ? and author like ?;
1718

            
1719
See also L<Tags/Tags>.
1720

            
1721
The following opitons are currently available.
1722

            
1723
=over 4
1724

            
1725
=item C<filter>
1726

            
1727
Filter, executed before data is send to database. This is array reference.
1728
Filter value is code reference or
1729
filter name registerd by C<register_filter()>.
1730

            
1731
    # Basic
1732
    $dbi->execute(
1733
        $sql,
1734
        filter => [
1735
            title  => sub { uc $_[0] }
1736
            author => sub { uc $_[0] }
1737
        ]
1738
    );
1739
    
1740
    # At once
1741
    $dbi->execute(
1742
        $sql,
1743
        filter => [
1744
            [qw/title author/]  => sub { uc $_[0] }
1745
        ]
1746
    );
1747
    
1748
    # Filter name
1749
    $dbi->execute(
1750
        $sql,
1751
        filter => [
1752
            title  => 'upper_case',
1753
            author => 'upper_case'
1754
        ]
1755
    );
1756

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

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

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

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

            
1765
Delete statement.
1766

            
1767
The following opitons are currently available.
1768

            
update pod
Yuki Kimoto authored on 2011-03-13
1769
=over 4
1770

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

            
1773
Table name.
1774

            
1775
    $dbi->delete(table => 'book');
1776

            
1777
=item C<where>
1778

            
1779
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
1780
    
1781
    # Hash reference
1782
    $dbi->delete(where => {title => 'Perl'});
1783
    
1784
    # DBIx::Custom::Where object
1785
    my $where = $dbi->where(
1786
        clause => ['and', '{= author}', '{like title}'],
1787
        param  => {author => 'Ken', title => '%Perl%'}
1788
    );
1789
    $dbi->delete(where => $where);
1790

            
1791
=item C<append>
1792

            
1793
Append statement to last of SQL. This is string.
1794

            
1795
    $dbi->delete(append => 'order by title');
1796

            
1797
=item C<filter>
1798

            
1799
Filter, executed before data is send to database. This is array reference.
1800
Filter value is code reference or
1801
filter name registerd by C<register_filter()>.
1802

            
1803
    # Basic
1804
    $dbi->delete(
1805
        filter => [
1806
            title  => sub { uc $_[0] }
1807
            author => sub { uc $_[0] }
1808
        ]
1809
    );
1810
    
1811
    # At once
1812
    $dbi->delete(
1813
        filter => [
1814
            [qw/title author/]  => sub { uc $_[0] }
1815
        ]
1816
    );
1817
    
1818
    # Filter name
1819
    $dbi->delete(
1820
        filter => [
1821
            title  => 'upper_case',
1822
            author => 'upper_case'
1823
        ]
1824
    );
1825

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1828
=item C<query> EXPERIMENTAL
update pod
Yuki Kimoto authored on 2011-03-13
1829

            
1830
Get L<DBIx::Custom::Query> object instead of executing SQL.
1831
This is true or false value.
1832

            
1833
    my $query = $dbi->delete(query => 1);
1834

            
1835
You can check SQL.
1836

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1839
=back
1840

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1848
=head2 C<delete_at()> EXPERIMENTAL
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1849

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

            
1852
    $dbi->delete_at(
1853
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1854
        primary_key => 'id',
1855
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1856
    );
1857

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1862
=over 4
1863

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1866
Primary key. This is constant value or array reference.
1867
    
1868
    # Constant value
1869
    $dbi->delete(primary_key => 'id');
1870

            
1871
    # Array reference
1872
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1873

            
1874
This is used to create where clause.
1875

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

            
1878
Where clause, created from primary key information.
1879
This is constant value or array reference.
1880

            
1881
    # Constant value
1882
    $dbi->delete(where => 5);
1883

            
1884
    # Array reference
1885
    $dbi->delete(where => [3, 5]);
1886

            
1887
In first examle, the following SQL is created.
1888

            
1889
    delete from book where id = ?;
1890

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1893
=back
1894

            
cleanup
yuki-kimoto authored on 2010-10-17
1895
=head2 C<insert>
1896

            
update pod
Yuki Kimoto authored on 2011-03-13
1897
    $dbi->insert(
1898
        table  => 'book', 
1899
        param  => {title => 'Perl', author => 'Ken'}
1900
    );
1901

            
1902
Insert statement.
1903

            
1904
The following opitons are currently available.
1905

            
update pod
Yuki Kimoto authored on 2011-03-13
1906
=over 4
1907

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

            
1910
Table name.
1911

            
1912
    $dbi->insert(table => 'book');
1913

            
1914
=item C<param>
1915

            
1916
Insert data. This is hash reference.
1917

            
1918
    $dbi->insert(param => {title => 'Perl'});
1919

            
1920
=item C<append>
1921

            
1922
Append statement to last of SQL. This is string.
1923

            
1924
    $dbi->insert(append => 'order by title');
1925

            
1926
=item C<filter>
1927

            
1928
Filter, executed before data is send to database. This is array reference.
1929
Filter value is code reference or
1930
filter name registerd by C<register_filter()>.
1931

            
1932
    # Basic
1933
    $dbi->insert(
1934
        filter => [
1935
            title  => sub { uc $_[0] }
1936
            author => sub { uc $_[0] }
1937
        ]
1938
    );
1939
    
1940
    # At once
1941
    $dbi->insert(
1942
        filter => [
1943
            [qw/title author/]  => sub { uc $_[0] }
1944
        ]
1945
    );
1946
    
1947
    # Filter name
1948
    $dbi->insert(
1949
        filter => [
1950
            title  => 'upper_case',
1951
            author => 'upper_case'
1952
        ]
1953
    );
1954

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1957
=item C<query> EXPERIMENTAL
update pod
Yuki Kimoto authored on 2011-03-13
1958

            
1959
Get L<DBIx::Custom::Query> object instead of executing SQL.
1960
This is true or false value.
1961

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

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

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

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

            
1970
=head2 C<insert_at()> EXPERIMENTAL
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1971

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

            
1974
    $dbi->insert_at(
1975
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1976
        primary_key => 'id',
1977
        where => '5',
1978
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1979
    );
1980

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1985
=over 4
1986

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

            
1989
Primary key. This is constant value or array reference.
1990
    
1991
    # Constant value
1992
    $dbi->insert(primary_key => 'id');
1993

            
1994
    # Array reference
1995
    $dbi->insert(primary_key => ['id1', 'id2' ]);
1996

            
1997
This is used to create parts of insert data.
1998

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

            
2001
Parts of Insert data, create from primary key information.
2002
This is constant value or array reference.
2003

            
2004
    # Constant value
2005
    $dbi->insert(where => 5);
2006

            
2007
    # Array reference
2008
    $dbi->insert(where => [3, 5]);
2009

            
2010
In first examle, the following SQL is created.
2011

            
2012
    insert into book (id, title) values (?, ?);
2013

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2016
=back
2017

            
2018
=head2 C<insert_param> EXPERIMENTAL
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2019

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

            
2022
Create insert parameter tag.
2023

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2026
=head2 C<each_column> EXPERIMENTAL
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2027

            
pod fix
Yuki Kimoto authored on 2011-01-21
2028
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2029
        sub {
update pod
Yuki Kimoto authored on 2011-03-13
2030
            my ($dbi, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2031
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2032
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
2033
            
2034
            if ($type eq 'DATE') {
2035
                # ...
2036
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2037
        }
2038
    );
update pod
Yuki Kimoto authored on 2011-03-13
2039

            
2040
Iterate all column informations of all table from database.
2041
Argument is callback when one column is found.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2042
Callback receive four arguments, dbi object, table name,
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2043
column name and column information.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2044

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2052
    lib / MyModel.pm
2053
        / MyModel / book.pm
2054
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2055

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

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

            
2060
    package MyModel;
2061
    
2062
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2063
    
2064
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2065

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2070
    package MyModel::book;
2071
    
2072
    use base 'MyModel';
2073
    
2074
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2075

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2078
    package MyModel::company;
2079
    
2080
    use base 'MyModel';
2081
    
2082
    1;
2083
    
2084
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2085

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

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

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

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

            
2095
    $dbi->method(
2096
        update_or_insert => sub {
2097
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2098
            
2099
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2100
        },
2101
        find_or_create   => sub {
2102
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2103
            
2104
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2105
        }
2106
    );
2107

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

            
2110
    $dbi->update_or_insert;
2111
    $dbi->find_or_create;
2112

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

            
2115
    $dbi->model('book')->method(
2116
        insert => sub { ... },
2117
        update => sub { ... }
2118
    );
2119
    
2120
    my $model = $dbi->model('book');
2121

            
2122
Set and get a L<DBIx::Custom::Model> object,
2123

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2126
    my $dbi = DBIx::Custom->new(
2127
        data_source => "dbi:mysql:database=dbname",
2128
        user => 'ken',
2129
        password => '!LFKD%$&',
2130
        dbi_option => {mysql_enable_utf8 => 1}
2131
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2132

            
2133
Create a new L<DBIx::Custom> object.
2134

            
update pod
Yuki Kimoto authored on 2011-03-13
2135
=head2 C<not_exists> EXPERIMENTAL
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2136

            
2137
    my $not_exists = $dbi->not_exists;
2138

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2142
=head2 C<register_filter>
2143

            
update pod
Yuki Kimoto authored on 2011-03-13
2144
    $dbi->register_filter(
2145
        # Time::Piece object to database DATE format
2146
        tp_to_date => sub {
2147
            my $tp = shift;
2148
            return $tp->strftime('%Y-%m-%d');
2149
        },
2150
        # database DATE format to Time::Piece object
2151
        date_to_tp => sub {
2152
           my $date = shift;
2153
           return Time::Piece->strptime($date, '%Y-%m-%d');
2154
        }
2155
    );
cleanup
yuki-kimoto authored on 2010-10-17
2156
    
update pod
Yuki Kimoto authored on 2011-03-13
2157
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2158

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2161
    $dbi->register_tag(
2162
        update => sub {
2163
            my @columns = @_;
2164
            
2165
            # Update parameters
2166
            my $s = 'set ';
2167
            $s .= "$_ = ?, " for @columns;
2168
            $s =~ s/, $//;
2169
            
2170
            return [$s, \@columns];
2171
        }
2172
    );
cleanup
yuki-kimoto authored on 2010-10-17
2173

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2197
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2198
        table  => 'book',
2199
        column => ['author', 'title'],
2200
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2201
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2202
    
update pod
Yuki Kimoto authored on 2011-03-12
2203
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2204

            
2205
The following opitons are currently available.
2206

            
2207
=over 4
2208

            
2209
=item C<table>
2210

            
2211
Table name.
2212

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

            
2215
=item C<column>
2216

            
2217
Column clause. This is array reference or constant value.
2218

            
2219
    # Hash refernce
2220
    $dbi->select(column => ['author', 'title']);
2221
    
2222
    # Constant value
2223
    $dbi->select(column => 'author');
2224

            
2225
Default is '*' unless C<column> is specified.
2226

            
2227
    # Default
2228
    $dbi->select(column => '*');
2229

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

            
2232
=over 4
2233

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2236
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
2237

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

            
2240
If main table is C<book> and joined table is C<company>,
2241
This create the following column clause.
2242

            
2243
    book.author as author
2244
    book.company_id as company_id
2245
    company.id as company__id
2246
    company.name as company__name
2247

            
2248
Columns of main table is consist of only column name,
2249
Columns of joined table is consist of table and column name joined C<__>.
2250

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

            
2254
    # Generally do the following way before using all_column option
2255
    $dbi->include_model('MyModel')->setup_model;
2256

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

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

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

            
2263
=item prepend EXPERIMENTAL
2264

            
2265
You can add before created statement
2266

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

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

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

            
2273
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2274
    
2275
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2276
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2277
    
update pod
Yuki Kimoto authored on 2011-03-12
2278
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2279
    my $where = $dbi->where(
2280
        clause => ['and', '{= author}', '{like title}'],
2281
        param  => {author => 'Ken', title => '%Perl%'}
2282
    );
update pod
Yuki Kimoto authored on 2011-03-12
2283
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2284

            
update pod
Yuki Kimoto authored on 2011-03-13
2285
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2286

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

            
2289
    $dbi->select(join =>
2290
        [
2291
            'left outer join company on book.company_id = company_id',
2292
            'left outer join location on company.location_id = location.id'
2293
        ]
2294
    );
2295

            
2296
If column cluase or where clause contain table name like "company.name",
2297
needed join clause is used automatically.
2298

            
2299
    $dbi->select(
2300
        table => 'book',
2301
        column => ['company.location_id as company__location_id'],
2302
        where => {'company.name' => 'Orange'},
2303
        join => [
2304
            'left outer join company on book.company_id = company.id',
2305
            'left outer join location on company.location_id = location.id'
2306
        ]
2307
    );
2308

            
2309
In above select, the following SQL is created.
2310

            
2311
    select company.location_id as company__location_id
2312
    from book
2313
      left outer join company on book.company_id = company.id
2314
    where company.name = Orange
2315

            
2316
=item C<append>
2317

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

            
2320
    $dbi->select(append => 'order by title');
2321

            
2322
=item C<filter>
2323

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

            
2328
    # Basic
2329
    $dbi->select(
2330
        filter => [
2331
            title  => sub { uc $_[0] }
2332
            author => sub { uc $_[0] }
2333
        ]
2334
    );
2335
    
2336
    # At once
2337
    $dbi->select(
2338
        filter => [
2339
            [qw/title author/]  => sub { uc $_[0] }
2340
        ]
2341
    );
2342
    
2343
    # Filter name
2344
    $dbi->select(
2345
        filter => [
2346
            title  => 'upper_case',
2347
            author => 'upper_case'
2348
        ]
2349
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2350

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2353
=item C<query> EXPERIMENTAL
cleanup
yuki-kimoto authored on 2010-08-09
2354

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

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

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

            
2362
    my $sql = $query->sql;
2363

            
2364
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2365

            
update pod
Yuki Kimoto authored on 2011-03-13
2366
=head2 C<select_at()> EXPERIMENTAL
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2367

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

            
2370
    $dbi->select_at(
2371
        table => 'book',
2372
        primary_key => 'id',
2373
        where => '5'
2374
    );
2375

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2380
=over 4
2381

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2384
Primary key. This is constant value or array reference.
2385
    
2386
    # Constant value
2387
    $dbi->select(primary_key => 'id');
2388

            
2389
    # Array reference
2390
    $dbi->select(primary_key => ['id1', 'id2' ]);
2391

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

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

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

            
2399
    # Constant value
2400
    $dbi->select(where => 5);
2401

            
2402
    # Array reference
2403
    $dbi->select(where => [3, 5]);
2404

            
2405
In first examle, the following SQL is created.
2406

            
2407
    select * from book where id = ?
2408

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2411
=back
2412

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2415
    $dbi->update(
2416
        table  => 'book',
2417
        param  => {title => 'Perl'},
2418
        where  => {id => 4}
2419
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2420

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2425
=over 4
2426

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2429
Table name.
2430

            
2431
    $dbi->update(table => 'book');
2432

            
2433
=item C<param>
2434

            
2435
Update data. This is hash reference.
2436

            
2437
    $dbi->update(param => {title => 'Perl'});
2438

            
2439
=item C<where>
2440

            
2441
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2442
    
2443
    # Hash reference
2444
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2445
    
2446
    # DBIx::Custom::Where object
2447
    my $where = $dbi->where(
2448
        clause => ['and', '{= author}', '{like title}'],
2449
        param  => {author => 'Ken', title => '%Perl%'}
2450
    );
2451
    $dbi->update(where => $where);
2452

            
2453
=item C<append>
2454

            
2455
Append statement to last of SQL. This is string.
2456

            
2457
    $dbi->update(append => 'order by title');
2458

            
2459
=item C<filter>
2460

            
2461
Filter, executed before data is send to database. This is array reference.
2462
Filter value is code reference or
2463
filter name registerd by C<register_filter()>.
2464

            
2465
    # Basic
2466
    $dbi->update(
2467
        filter => [
2468
            title  => sub { uc $_[0] }
2469
            author => sub { uc $_[0] }
2470
        ]
2471
    );
2472
    
2473
    # At once
2474
    $dbi->update(
2475
        filter => [
2476
            [qw/title author/]  => sub { uc $_[0] }
2477
        ]
2478
    );
2479
    
2480
    # Filter name
2481
    $dbi->update(
2482
        filter => [
2483
            title  => 'upper_case',
2484
            author => 'upper_case'
2485
        ]
2486
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2487

            
update pod
Yuki Kimoto authored on 2011-03-13
2488
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
2489

            
update pod
Yuki Kimoto authored on 2011-03-13
2490
=item C<query> EXPERIMENTAL
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2491

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

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

            
2497
You can check SQL.
2498

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2501
=back
2502

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2510
=head2 C<update_at()> EXPERIMENTAL
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2511

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

            
2514
    $dbi->update_at(
2515
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2516
        primary_key => 'id',
2517
        where => '5',
2518
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2519
    );
2520

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2525
=over 4
2526

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

            
2529
Primary key. This is constant value or array reference.
2530
    
2531
    # Constant value
2532
    $dbi->update(primary_key => 'id');
2533

            
2534
    # Array reference
2535
    $dbi->update(primary_key => ['id1', 'id2' ]);
2536

            
2537
This is used to create where clause.
2538

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

            
2541
Where clause, created from primary key information.
2542
This is constant value or array reference.
2543

            
2544
    # Constant value
2545
    $dbi->update(where => 5);
2546

            
2547
    # Array reference
2548
    $dbi->update(where => [3, 5]);
2549

            
2550
In first examle, the following SQL is created.
2551

            
2552
    update book set title = ? where id = ?
2553

            
2554
Place holders are set to 'Perl' and 5.
2555

            
update pod
Yuki Kimoto authored on 2011-03-13
2556
=back
2557

            
2558
=head2 C<update_param> EXPERIMENTAL
update pod
Yuki Kimoto authored on 2011-03-13
2559

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

            
2562
Create update parameter tag.
2563

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2566
=head2 C<where> EXPERIMENTAL
fix tests
Yuki Kimoto authored on 2011-01-18
2567

            
cleanup
Yuki Kimoto authored on 2011-03-09
2568
    my $where = $dbi->where(
2569
        clause => ['and', '{= title}', '{= author}'],
2570
        param => {title => 'Perl', author => 'Ken'}
2571
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2572

            
2573
Create a new L<DBIx::Custom::Where> object.
2574

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2582
=head1 Tags
2583

            
2584
The following tags is available.
2585

            
update pod
Yuki Kimoto authored on 2011-03-13
2586
=head2 C<table> EXPERIMENTAL
add table tag
Yuki Kimoto authored on 2011-02-09
2587

            
2588
Table tag
2589

            
2590
    {table TABLE}    ->    TABLE
2591

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2594
=head2 C<?>
2595

            
2596
Placeholder tag.
2597

            
2598
    {? NAME}    ->   ?
2599

            
2600
=head2 C<=>
2601

            
2602
Equal tag.
2603

            
2604
    {= NAME}    ->   NAME = ?
2605

            
2606
=head2 C<E<lt>E<gt>>
2607

            
2608
Not equal tag.
2609

            
2610
    {<> NAME}   ->   NAME <> ?
2611

            
2612
=head2 C<E<lt>>
2613

            
2614
Lower than tag
2615

            
2616
    {< NAME}    ->   NAME < ?
2617

            
2618
=head2 C<E<gt>>
2619

            
2620
Greater than tag
2621

            
2622
    {> NAME}    ->   NAME > ?
2623

            
2624
=head2 C<E<gt>=>
2625

            
2626
Greater than or equal tag
2627

            
2628
    {>= NAME}   ->   NAME >= ?
2629

            
2630
=head2 C<E<lt>=>
2631

            
2632
Lower than or equal tag
2633

            
2634
    {<= NAME}   ->   NAME <= ?
2635

            
2636
=head2 C<like>
2637

            
2638
Like tag
2639

            
2640
    {like NAME}   ->   NAME like ?
2641

            
2642
=head2 C<in>
2643

            
2644
In tag.
2645

            
2646
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2647

            
2648
=head2 C<insert_param>
2649

            
2650
Insert parameter tag.
2651

            
2652
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2653

            
2654
=head2 C<update_param>
2655

            
2656
Updata parameter tag.
2657

            
2658
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2659

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

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

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

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

            
2669
C<< <kimoto.yuki at gmail.com> >>
2670

            
2671
L<http://github.com/yuki-kimoto/DBIx-Custom>
2672

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2673
=head1 AUTHOR
2674

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

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

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

            
2681
This program is free software; you can redistribute it and/or modify it
2682
under the same terms as Perl itself.
2683

            
2684
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2685

            
2686