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

            
cleanup
Yuki Kimoto authored on 2011-03-21
3
our $VERSION = '0.1663';
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

            
cleanup
Yuki Kimoto authored on 2011-03-21
22
our @COMMON_ARGS = qw/table query filter bind_param_option/;
23

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-27
285
    # SQL stack
286
    my @sql;
287

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

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
308
our %VALID_DELETE_AT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
309
  = (%VALID_DELETE_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
310

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
349
sub DESTROY { }
350

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

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

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

            
472
        return $result;
473
    }
474
    return $affected;
475
}
476

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

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

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

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
530
our %VALID_INSERT_AT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
531
  = (%VALID_INSERT_ARGS, where => 1, primary_key => 1);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
532

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
686
sub method {
687
    my $self = shift;
688
    
689
    # Merge
690
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
691
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
692
    
693
    return $self;
694
}
695

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
696
sub model {
697
    my ($self, $name, $model) = @_;
698
    
699
    # Set
700
    if ($model) {
701
        $self->models->{$name} = $model;
702
        return $self;
703
    }
704
    
705
    # Check model existance
706
    croak qq{Model "$name" is not included}
707
      unless $self->models->{$name};
708
    
709
    # Get
710
    return $self->models->{$name};
711
}
712

            
cleanup
Yuki Kimoto authored on 2011-03-21
713
sub mycolumn {
714
    my ($self, $table, $columns) = @_;
715
    
716
    $columns ||= [];
717
    my @column;
718
    push @column, "$table.$_ as $_" for @$columns;
719
    
720
    return join (', ', @column);
721
}
722

            
added dbi_options attribute
kimoto authored on 2010-12-20
723
sub new {
724
    my $self = shift->SUPER::new(@_);
725
    
726
    # Check attribute names
727
    my @attrs = keys %$self;
728
    foreach my $attr (@attrs) {
729
        croak qq{"$attr" is invalid attribute name}
730
          unless $self->can($attr);
731
    }
cleanup
Yuki Kimoto authored on 2011-01-25
732

            
733
    $self->register_tag(
734
        '?'     => \&DBIx::Custom::Tag::placeholder,
735
        '='     => \&DBIx::Custom::Tag::equal,
736
        '<>'    => \&DBIx::Custom::Tag::not_equal,
737
        '>'     => \&DBIx::Custom::Tag::greater_than,
738
        '<'     => \&DBIx::Custom::Tag::lower_than,
739
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
740
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
741
        'like'  => \&DBIx::Custom::Tag::like,
742
        'in'    => \&DBIx::Custom::Tag::in,
743
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
744
        'update_param' => \&DBIx::Custom::Tag::update_param
745
    );
added dbi_options attribute
kimoto authored on 2010-12-20
746
    
747
    return $self;
748
}
749

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

            
cleanup
yuki-kimoto authored on 2010-10-17
752
sub register_filter {
753
    my $invocant = shift;
754
    
755
    # Register filter
756
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
757
    $invocant->filters({%{$invocant->filters}, %$filters});
758
    
759
    return $invocant;
760
}
packaging one directory
yuki-kimoto authored on 2009-11-16
761

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
764
our %VALID_SELECT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
765
  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation
766
                                     selection join/;
refactoring select
yuki-kimoto authored on 2010-04-28
767

            
packaging one directory
yuki-kimoto authored on 2009-11-16
768
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
769
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
770
    
cleanup
Yuki Kimoto authored on 2011-03-09
771
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
772
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
773
        croak qq{Argument "$name" is invalid name}
refactoring select
yuki-kimoto authored on 2010-04-28
774
          unless $VALID_SELECT_ARGS{$name};
775
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
776
    
refactoring select
yuki-kimoto authored on 2010-04-28
777
    # Arguments
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
778
    my $table = $args{table};
779
    my $tables = ref $table eq 'ARRAY' ? $table
780
               : defined $table ? [$table]
781
               : [];
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
782
    my $columns   = $args{column};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
783
    my $selection = $args{selection} || '';
784
    my $where     = $args{where} || {};
785
    my $append    = $args{append};
786
    my $filter    = $args{filter};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
787
    my $join =     $args{join} || [];
788
    croak qq{"join" must be array reference}
789
      unless ref $join eq 'ARRAY';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
790
    
cleanup
Yuki Kimoto authored on 2011-03-09
791
    # Add relation tables(DEPRECATED!);
792
    $self->_add_relation_table($tables, $args{relation});
packaging one directory
yuki-kimoto authored on 2009-11-16
793
    
cleanup
Yuki Kimoto authored on 2011-01-27
794
    # SQL stack
795
    my @sql;
796
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
797
    
cleanup
Yuki Kimoto authored on 2011-03-09
798
    # Selection
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
799
    if ($selection) { 
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
800
        push @sql, $selection;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
801
        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {
802
             unshift @$tables, $1;
803
        }
804
        unshift @$tables, @{$self->_tables($selection)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
805
    }
cleanup
Yuki Kimoto authored on 2011-03-09
806
    
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
807
    # Column clause
808
    elsif ($columns) {
809

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
933
our %VALID_SELECT_AT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
934
  = (%VALID_SELECT_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
935

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
978
sub setup_model {
979
    my $self = shift;
980
    
981
    $self->each_column(
982
        sub {
983
            my ($self, $table, $column, $column_info) = @_;
984
            
985
            if (my $model = $self->models->{$table}) {
986
                push @{$model->columns}, $column;
987
            }
988
        }
989
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
990
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
991
}
992

            
cleanup
yuki-kimoto authored on 2010-10-17
993
our %VALID_UPDATE_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
994
  = map { $_ => 1 } @COMMON_ARGS, qw/param where append
995
                                     allow_update_all/;
cleanup
yuki-kimoto authored on 2010-10-17
996

            
997
sub update {
998
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
999
    
cleanup
Yuki Kimoto authored on 2011-03-09
1000
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1001
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1002
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
1003
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1004
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1005
    
cleanup
yuki-kimoto authored on 2010-10-17
1006
    # Arguments
1007
    my $table            = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1008
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
1009
    my $param            = $args{param} || {};
1010
    my $where            = $args{where} || {};
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1011
    my $append           = $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
1012
    my $filter           = $args{filter};
1013
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1014
    
cleanup
yuki-kimoto authored on 2010-10-17
1015
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1016
    my @clumns = keys %$param;
1017

            
1018
    # Columns
1019
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1020
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1021
    foreach my $column (keys %$param) {
1022
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1023
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1024
        push @columns, $column;
1025
    }
1026
        
cleanup
yuki-kimoto authored on 2010-10-17
1027
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1028
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1029

            
1030
    # Where
1031
    my $w;
1032
    if (ref $where eq 'HASH') {
1033
        my $clause = ['and'];
1034
        push @$clause, "{= $_}" for keys %$where;
1035
        $w = $self->where;
1036
        $w->clause($clause);
1037
        $w->param($where);
1038
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1039
    elsif (ref $where eq 'DBIx::Custom::Where') {
1040
        $w = $where;
1041
        $where = $w->param;
1042
    }  
removed experimental registe...
yuki-kimoto authored on 2010-08-24
1043
    
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1044
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
1045
      unless ref $w eq 'DBIx::Custom::Where';
removed reconnect method
yuki-kimoto authored on 2010-05-28
1046
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1047
    # String where
1048
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1049
    
1050
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1051
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1052
    
cleanup
Yuki Kimoto authored on 2011-01-27
1053
    # SQL stack
1054
    my @sql;
1055
    
1056
    # Update
1057
    push @sql, "update $table $update_clause $swhere";
1058
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1059
    
cleanup
yuki-kimoto authored on 2010-10-17
1060
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1061
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1062
        
cleanup
yuki-kimoto authored on 2010-10-17
1063
        if (exists $param->{$wkey}) {
1064
            $param->{$wkey} = [$param->{$wkey}]
1065
              unless ref $param->{$wkey} eq 'ARRAY';
1066
            
1067
            push @{$param->{$wkey}}, $where->{$wkey};
1068
        }
1069
        else {
1070
            $param->{$wkey} = $where->{$wkey};
1071
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1072
    }
cleanup
yuki-kimoto authored on 2010-10-17
1073
    
cleanup
Yuki Kimoto authored on 2011-01-27
1074
    # SQL
1075
    my $sql = join(' ', @sql);
1076
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1077
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1078
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1079
    return $query if $args{query};
1080
    
cleanup
yuki-kimoto authored on 2010-10-17
1081
    # Execute query
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1082
    my $ret_val = $self->execute($query, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1083
                                 filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1084
                                 table => $table);
cleanup
yuki-kimoto authored on 2010-10-17
1085
    
1086
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1087
}
1088

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1313
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1314
__PACKAGE__->attr(
1315
    dbi_options => sub { {} },
1316
    filter_check  => 1
1317
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1318

            
cleanup
Yuki Kimoto authored on 2011-01-25
1319
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1320
sub default_bind_filter {
1321
    my $self = shift;
1322
    
1323
    if (@_) {
1324
        my $fname = $_[0];
1325
        
1326
        if (@_ && !$fname) {
1327
            $self->{default_out_filter} = undef;
1328
        }
1329
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1330
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1331
              unless exists $self->filters->{$fname};
1332
        
1333
            $self->{default_out_filter} = $self->filters->{$fname};
1334
        }
1335
        return $self;
1336
    }
1337
    
1338
    return $self->{default_out_filter};
1339
}
1340

            
cleanup
Yuki Kimoto authored on 2011-01-25
1341
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1342
sub default_fetch_filter {
1343
    my $self = shift;
1344
    
1345
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1346
        my $fname = $_[0];
1347

            
cleanup
Yuki Kimoto authored on 2011-01-12
1348
        if (@_ && !$fname) {
1349
            $self->{default_in_filter} = undef;
1350
        }
1351
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1352
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1353
              unless exists $self->filters->{$fname};
1354
        
1355
            $self->{default_in_filter} = $self->filters->{$fname};
1356
        }
1357
        
1358
        return $self;
1359
    }
1360
    
many changed
Yuki Kimoto authored on 2011-01-23
1361
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1362
}
1363

            
cleanup
Yuki Kimoto authored on 2011-01-25
1364
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1365
sub register_tag_processor {
1366
    return shift->query_builder->register_tag_processor(@_);
1367
}
1368

            
cleanup
Yuki Kimoto authored on 2011-03-08
1369
# DEPRECATED!
1370
sub _push_relation {
1371
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1372
    
1373
    if (keys %{$relation || {}}) {
1374
        push @$sql, $need_where ? 'where' : 'and';
1375
        foreach my $rcolumn (keys %$relation) {
1376
            my $table1 = (split (/\./, $rcolumn))[0];
1377
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1378
            push @$tables, ($table1, $table2);
1379
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1380
        }
1381
    }
1382
    pop @$sql if $sql->[-1] eq 'and';    
1383
}
1384

            
1385
# DEPRECATED!
1386
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1387
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1388
    
1389
    if (keys %{$relation || {}}) {
1390
        foreach my $rcolumn (keys %$relation) {
1391
            my $table1 = (split (/\./, $rcolumn))[0];
1392
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1393
            my $table1_exists;
1394
            my $table2_exists;
1395
            foreach my $table (@$tables) {
1396
                $table1_exists = 1 if $table eq $table1;
1397
                $table2_exists = 1 if $table eq $table2;
1398
            }
1399
            unshift @$tables, $table1 unless $table1_exists;
1400
            unshift @$tables, $table2 unless $table2_exists;
1401
        }
1402
    }
1403
}
1404

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1407
=head1 NAME
1408

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

            
1411
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1412

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1413
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1414
    
1415
    # Connect
1416
    my $dbi = DBIx::Custom->connect(
1417
        data_source => "dbi:mysql:database=dbname",
1418
        user => 'ken',
1419
        password => '!LFKD%$&',
1420
        dbi_option => {mysql_enable_utf8 => 1}
1421
    );
cleanup
yuki-kimoto authored on 2010-08-05
1422

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1423
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1424
    $dbi->insert(
1425
        table  => 'book',
1426
        param  => {title => 'Perl', author => 'Ken'}
1427
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1428
    
1429
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1430
    $dbi->update(
1431
        table  => 'book', 
1432
        param  => {title => 'Perl', author => 'Ken'}, 
1433
        where  => {id => 5},
1434
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1435
    
1436
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1437
    $dbi->delete(
1438
        table  => 'book',
1439
        where  => {author => 'Ken'},
1440
    );
cleanup
yuki-kimoto authored on 2010-08-05
1441

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1448
    # Select, more complex
1449
    my $result = $dbi->select(
1450
        table  => 'book',
1451
        column => [
1452
            'book.author as book__author',
1453
            'company.name as company__name'
1454
        ],
1455
        where  => {'book.author' => 'Ken'},
1456
        join => ['left outer join company on book.company_id = company.id'],
1457
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1458
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1459
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1460
    # Fetch
1461
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1462
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1463
    }
1464
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1465
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1466
    while (my $row = $result->fetch_hash) {
1467
        
1468
    }
1469
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1470
    # Execute SQL with parameter.
1471
    $dbi->execute(
1472
        "select id from book where {= author} and {like title}",
1473
        param  => {author => 'ken', title => '%Perl%'}
1474
    );
1475
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1476
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1477

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

            
1480
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1481

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1486
There are many basic methods to execute various queries.
1487
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1488
C<delete_all()>, C<select()>,
1489
C<insert_at()>, C<update_at()>, 
1490
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1491

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1492
=item *
1493

            
1494
Filter when data is send or receive.
1495

            
1496
=item *
1497

            
1498
Data filtering system
1499

            
1500
=item *
1501

            
1502
Model support.
1503

            
1504
=item *
1505

            
1506
Generate where clause dinamically.
1507

            
1508
=item *
1509

            
1510
Generate join clause dinamically.
1511

            
1512
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1513

            
1514
=head1 GUIDE
1515

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1547
=head2 C<default_dbi_option>
1548

            
1549
    my $default_dbi_option = $dbi->default_dbi_option;
1550
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1551

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1555
    {
1556
        RaiseError => 1,
1557
        PrintError => 0,
1558
        AutoCommit => 1,
1559
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1560

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

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

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

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

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

            
1573
    my $models = $dbi->models;
1574
    $dbi       = $dbi->models(\%models);
1575

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1578
=head2 C<password>
1579

            
1580
    my $password = $dbi->password;
1581
    $dbi         = $dbi->password('lkj&le`@s');
1582

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1609
    my $user = $dbi->user;
1610
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1611

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1622
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1623
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1624
        'issue_date' => {
1625
            out => 'tp_to_date',
1626
            in  => 'date_to_tp',
1627
            end => 'tp_to_displaydate'
1628
        },
1629
        'write_date' => {
1630
            out => 'tp_to_date',
1631
            in  => 'date_to_tp',
1632
            end => 'tp_to_displaydate'
1633
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1634
    );
1635

            
update pod
Yuki Kimoto authored on 2011-03-13
1636
Apply filter to columns.
1637
C<out> filter is executed before data is send to database.
1638
C<in> filter is executed after a row is fetch.
1639
C<end> filter is execute after C<in> filter is executed.
1640

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1643
       PETTERN         EXAMPLE
1644
    1. Column        : author
1645
    2. Table.Column  : book.author
1646
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1647

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

            
1651
You can set multiple filters at once.
1652

            
1653
    $dbi->apply_filter(
1654
        'book',
1655
        [qw/issue_date write_date/] => {
1656
            out => 'tp_to_date',
1657
            in  => 'date_to_tp',
1658
            end => 'tp_to_displaydate'
1659
        }
1660
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1661

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

            
1664
    $dbi          = $dbi->cache_method(\&cache_method);
1665
    $cache_method = $dbi->cache_method
1666

            
update pod
Yuki Kimoto authored on 2011-03-13
1667
Method to set and get cache.
1668
Default to the following one.
1669

            
1670
    sub {
1671
        my $self = shift;
1672
        
1673
        $self->{_cached} ||= {};
1674
        
1675
        if (@_ > 1) {
1676
            $self->{_cached}{$_[0]} = $_[1];
1677
        }
1678
        else {
1679
            return $self->{_cached}{$_[0]};
1680
        }
1681
    }
update pod
Yuki Kimoto authored on 2011-03-13
1682

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1685
    my $dbi = DBIx::Custom->connect(
1686
        data_source => "dbi:mysql:database=dbname",
1687
        user => 'ken',
1688
        password => '!LFKD%$&',
1689
        dbi_option => {mysql_enable_utf8 => 1}
1690
    );
1691

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1698
=head2 C<create_query>
1699
    
1700
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1701
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1702
    );
update document
yuki-kimoto authored on 2009-11-19
1703

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

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

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

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

            
1714
    my $dbh = $dbi->dbh;
1715
    $dbi    = $dbi->dbh($dbh);
1716

            
1717
Get and set database handle of L<DBI>.
1718

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1724
    my $result = $dbi->execute(
1725
        "select * from book where {= title} and {like author}",
1726
        param => {title => 'Perl', author => '%Ken%'}
1727
    );
1728

            
1729
Execute SQL, containing tags.
1730
Return value is L<DBIx::Custom::Result> in select statement, or
1731
the count of affected rows in insert, update, delete statement.
1732

            
1733
Tag is turned into the statement containing place holder
1734
before SQL is executed.
1735

            
1736
    select * from where title = ? and author like ?;
1737

            
1738
See also L<Tags/Tags>.
1739

            
1740
The following opitons are currently available.
1741

            
1742
=over 4
1743

            
1744
=item C<filter>
1745

            
1746
Filter, executed before data is send to database. This is array reference.
1747
Filter value is code reference or
1748
filter name registerd by C<register_filter()>.
1749

            
1750
    # Basic
1751
    $dbi->execute(
1752
        $sql,
1753
        filter => [
1754
            title  => sub { uc $_[0] }
1755
            author => sub { uc $_[0] }
1756
        ]
1757
    );
1758
    
1759
    # At once
1760
    $dbi->execute(
1761
        $sql,
1762
        filter => [
1763
            [qw/title author/]  => sub { uc $_[0] }
1764
        ]
1765
    );
1766
    
1767
    # Filter name
1768
    $dbi->execute(
1769
        $sql,
1770
        filter => [
1771
            title  => 'upper_case',
1772
            author => 'upper_case'
1773
        ]
1774
    );
1775

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

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

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

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

            
1784
Delete statement.
1785

            
1786
The following opitons are currently available.
1787

            
update pod
Yuki Kimoto authored on 2011-03-13
1788
=over 4
1789

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

            
1792
Table name.
1793

            
1794
    $dbi->delete(table => 'book');
1795

            
1796
=item C<where>
1797

            
1798
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
1799
    
1800
    # Hash reference
1801
    $dbi->delete(where => {title => 'Perl'});
1802
    
1803
    # DBIx::Custom::Where object
1804
    my $where = $dbi->where(
1805
        clause => ['and', '{= author}', '{like title}'],
1806
        param  => {author => 'Ken', title => '%Perl%'}
1807
    );
1808
    $dbi->delete(where => $where);
1809

            
1810
=item C<append>
1811

            
1812
Append statement to last of SQL. This is string.
1813

            
1814
    $dbi->delete(append => 'order by title');
1815

            
1816
=item C<filter>
1817

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

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

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

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

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

            
1851
Create column clause. The follwoing column clause is created.
1852

            
1853
    book.author as book__author,
1854
    book.title as book__title
1855

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

            
1858
Get L<DBIx::Custom::Query> object instead of executing SQL.
1859
This is true or false value.
1860

            
1861
    my $query = $dbi->delete(query => 1);
1862

            
1863
You can check SQL.
1864

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1867
=back
1868

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

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

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

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

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

            
1880
    $dbi->delete_at(
1881
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1882
        primary_key => 'id',
1883
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1884
    );
1885

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1890
=over 4
1891

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1894
Primary key. This is constant value or array reference.
1895
    
1896
    # Constant value
1897
    $dbi->delete(primary_key => 'id');
1898

            
1899
    # Array reference
1900
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1901

            
1902
This is used to create where clause.
1903

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

            
1906
Where clause, created from primary key information.
1907
This is constant value or array reference.
1908

            
1909
    # Constant value
1910
    $dbi->delete(where => 5);
1911

            
1912
    # Array reference
1913
    $dbi->delete(where => [3, 5]);
1914

            
1915
In first examle, the following SQL is created.
1916

            
1917
    delete from book where id = ?;
1918

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1921
=back
1922

            
cleanup
yuki-kimoto authored on 2010-10-17
1923
=head2 C<insert>
1924

            
update pod
Yuki Kimoto authored on 2011-03-13
1925
    $dbi->insert(
1926
        table  => 'book', 
1927
        param  => {title => 'Perl', author => 'Ken'}
1928
    );
1929

            
1930
Insert statement.
1931

            
1932
The following opitons are currently available.
1933

            
update pod
Yuki Kimoto authored on 2011-03-13
1934
=over 4
1935

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

            
1938
Table name.
1939

            
1940
    $dbi->insert(table => 'book');
1941

            
1942
=item C<param>
1943

            
1944
Insert data. This is hash reference.
1945

            
1946
    $dbi->insert(param => {title => 'Perl'});
1947

            
1948
=item C<append>
1949

            
1950
Append statement to last of SQL. This is string.
1951

            
1952
    $dbi->insert(append => 'order by title');
1953

            
1954
=item C<filter>
1955

            
1956
Filter, executed before data is send to database. This is array reference.
1957
Filter value is code reference or
1958
filter name registerd by C<register_filter()>.
1959

            
1960
    # Basic
1961
    $dbi->insert(
1962
        filter => [
1963
            title  => sub { uc $_[0] }
1964
            author => sub { uc $_[0] }
1965
        ]
1966
    );
1967
    
1968
    # At once
1969
    $dbi->insert(
1970
        filter => [
1971
            [qw/title author/]  => sub { uc $_[0] }
1972
        ]
1973
    );
1974
    
1975
    # Filter name
1976
    $dbi->insert(
1977
        filter => [
1978
            title  => 'upper_case',
1979
            author => 'upper_case'
1980
        ]
1981
    );
1982

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

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

            
1987
Get L<DBIx::Custom::Query> object instead of executing SQL.
1988
This is true or false value.
1989

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1996
=back
1997

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

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

            
2002
    $dbi->insert_at(
2003
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2004
        primary_key => 'id',
2005
        where => '5',
2006
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2007
    );
2008

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

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

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

            
2017
Primary key. This is constant value or array reference.
2018
    
2019
    # Constant value
2020
    $dbi->insert(primary_key => 'id');
2021

            
2022
    # Array reference
2023
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2024

            
2025
This is used to create parts of insert data.
2026

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

            
2029
Parts of Insert data, create from primary key information.
2030
This is constant value or array reference.
2031

            
2032
    # Constant value
2033
    $dbi->insert(where => 5);
2034

            
2035
    # Array reference
2036
    $dbi->insert(where => [3, 5]);
2037

            
2038
In first examle, the following SQL is created.
2039

            
2040
    insert into book (id, title) values (?, ?);
2041

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2044
=back
2045

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

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

            
2050
Create insert parameter tag.
2051

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

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

            
pod fix
Yuki Kimoto authored on 2011-01-21
2056
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2057
        sub {
update pod
Yuki Kimoto authored on 2011-03-13
2058
            my ($dbi, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2059
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2060
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
2061
            
2062
            if ($type eq 'DATE') {
2063
                # ...
2064
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2065
        }
2066
    );
update pod
Yuki Kimoto authored on 2011-03-13
2067

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2080
    lib / MyModel.pm
2081
        / MyModel / book.pm
2082
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2083

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

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

            
2088
    package MyModel;
2089
    
2090
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2091
    
2092
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2093

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2098
    package MyModel::book;
2099
    
2100
    use base 'MyModel';
2101
    
2102
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2103

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2106
    package MyModel::company;
2107
    
2108
    use base 'MyModel';
2109
    
2110
    1;
2111
    
2112
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2113

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

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

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

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

            
2123
    $dbi->method(
2124
        update_or_insert => sub {
2125
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2126
            
2127
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2128
        },
2129
        find_or_create   => sub {
2130
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2131
            
2132
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2133
        }
2134
    );
2135

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

            
2138
    $dbi->update_or_insert;
2139
    $dbi->find_or_create;
2140

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

            
2143
    $dbi->model('book')->method(
2144
        insert => sub { ... },
2145
        update => sub { ... }
2146
    );
2147
    
2148
    my $model = $dbi->model('book');
2149

            
2150
Set and get a L<DBIx::Custom::Model> object,
2151

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

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

            
2156
Create column clause for myself. The follwoing column clause is created.
2157

            
2158
    book.author as author,
2159
    book.title as title
2160

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2163
    my $dbi = DBIx::Custom->new(
2164
        data_source => "dbi:mysql:database=dbname",
2165
        user => 'ken',
2166
        password => '!LFKD%$&',
2167
        dbi_option => {mysql_enable_utf8 => 1}
2168
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2169

            
2170
Create a new L<DBIx::Custom> object.
2171

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

            
2174
    my $not_exists = $dbi->not_exists;
2175

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2179
=head2 C<register_filter>
2180

            
update pod
Yuki Kimoto authored on 2011-03-13
2181
    $dbi->register_filter(
2182
        # Time::Piece object to database DATE format
2183
        tp_to_date => sub {
2184
            my $tp = shift;
2185
            return $tp->strftime('%Y-%m-%d');
2186
        },
2187
        # database DATE format to Time::Piece object
2188
        date_to_tp => sub {
2189
           my $date = shift;
2190
           return Time::Piece->strptime($date, '%Y-%m-%d');
2191
        }
2192
    );
cleanup
yuki-kimoto authored on 2010-10-17
2193
    
update pod
Yuki Kimoto authored on 2011-03-13
2194
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2195

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2198
    $dbi->register_tag(
2199
        update => sub {
2200
            my @columns = @_;
2201
            
2202
            # Update parameters
2203
            my $s = 'set ';
2204
            $s .= "$_ = ?, " for @columns;
2205
            $s =~ s/, $//;
2206
            
2207
            return [$s, \@columns];
2208
        }
2209
    );
cleanup
yuki-kimoto authored on 2010-10-17
2210

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2234
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2235
        table  => 'book',
2236
        column => ['author', 'title'],
2237
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2238
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2239
    
update pod
Yuki Kimoto authored on 2011-03-12
2240
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2241

            
2242
The following opitons are currently available.
2243

            
2244
=over 4
2245

            
2246
=item C<table>
2247

            
2248
Table name.
2249

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

            
2252
=item C<column>
2253

            
2254
Column clause. This is array reference or constant value.
2255

            
2256
    # Hash refernce
2257
    $dbi->select(column => ['author', 'title']);
2258
    
2259
    # Constant value
2260
    $dbi->select(column => 'author');
2261

            
2262
Default is '*' unless C<column> is specified.
2263

            
2264
    # Default
2265
    $dbi->select(column => '*');
2266

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

            
2269
=over 4
2270

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

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

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

            
2277
If main table is C<book> and joined table is C<company>,
2278
This create the following column clause.
2279

            
2280
    book.author as author
2281
    book.company_id as company_id
2282
    company.id as company__id
2283
    company.name as company__name
2284

            
2285
Columns of main table is consist of only column name,
2286
Columns of joined table is consist of table and column name joined C<__>.
2287

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

            
2291
    # Generally do the following way before using all_column option
2292
    $dbi->include_model('MyModel')->setup_model;
2293

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

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

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

            
2300
=item prepend EXPERIMENTAL
2301

            
2302
You can add before created statement
2303

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

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

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

            
2310
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2311
    
2312
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2313
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2314
    
update pod
Yuki Kimoto authored on 2011-03-12
2315
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2316
    my $where = $dbi->where(
2317
        clause => ['and', '{= author}', '{like title}'],
2318
        param  => {author => 'Ken', title => '%Perl%'}
2319
    );
update pod
Yuki Kimoto authored on 2011-03-12
2320
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2321

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

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

            
2326
    $dbi->select(join =>
2327
        [
2328
            'left outer join company on book.company_id = company_id',
2329
            'left outer join location on company.location_id = location.id'
2330
        ]
2331
    );
2332

            
2333
If column cluase or where clause contain table name like "company.name",
2334
needed join clause is used automatically.
2335

            
2336
    $dbi->select(
2337
        table => 'book',
2338
        column => ['company.location_id as company__location_id'],
2339
        where => {'company.name' => 'Orange'},
2340
        join => [
2341
            'left outer join company on book.company_id = company.id',
2342
            'left outer join location on company.location_id = location.id'
2343
        ]
2344
    );
2345

            
2346
In above select, the following SQL is created.
2347

            
2348
    select company.location_id as company__location_id
2349
    from book
2350
      left outer join company on book.company_id = company.id
2351
    where company.name = Orange
2352

            
2353
=item C<append>
2354

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

            
2357
    $dbi->select(append => 'order by title');
2358

            
2359
=item C<filter>
2360

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

            
2365
    # Basic
2366
    $dbi->select(
2367
        filter => [
2368
            title  => sub { uc $_[0] }
2369
            author => sub { uc $_[0] }
2370
        ]
2371
    );
2372
    
2373
    # At once
2374
    $dbi->select(
2375
        filter => [
2376
            [qw/title author/]  => sub { uc $_[0] }
2377
        ]
2378
    );
2379
    
2380
    # Filter name
2381
    $dbi->select(
2382
        filter => [
2383
            title  => 'upper_case',
2384
            author => 'upper_case'
2385
        ]
2386
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2387

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

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

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

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

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

            
2399
    my $sql = $query->sql;
2400

            
2401
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2402

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

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

            
2407
    $dbi->select_at(
2408
        table => 'book',
2409
        primary_key => 'id',
2410
        where => '5'
2411
    );
2412

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2417
=over 4
2418

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2421
Primary key. This is constant value or array reference.
2422
    
2423
    # Constant value
2424
    $dbi->select(primary_key => 'id');
2425

            
2426
    # Array reference
2427
    $dbi->select(primary_key => ['id1', 'id2' ]);
2428

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

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

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

            
2436
    # Constant value
2437
    $dbi->select(where => 5);
2438

            
2439
    # Array reference
2440
    $dbi->select(where => [3, 5]);
2441

            
2442
In first examle, the following SQL is created.
2443

            
2444
    select * from book where id = ?
2445

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2448
=back
2449

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2452
    $dbi->update(
2453
        table  => 'book',
2454
        param  => {title => 'Perl'},
2455
        where  => {id => 4}
2456
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2457

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2462
=over 4
2463

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2466
Table name.
2467

            
2468
    $dbi->update(table => 'book');
2469

            
2470
=item C<param>
2471

            
2472
Update data. This is hash reference.
2473

            
2474
    $dbi->update(param => {title => 'Perl'});
2475

            
2476
=item C<where>
2477

            
2478
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2479
    
2480
    # Hash reference
2481
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2482
    
2483
    # DBIx::Custom::Where object
2484
    my $where = $dbi->where(
2485
        clause => ['and', '{= author}', '{like title}'],
2486
        param  => {author => 'Ken', title => '%Perl%'}
2487
    );
2488
    $dbi->update(where => $where);
2489

            
2490
=item C<append>
2491

            
2492
Append statement to last of SQL. This is string.
2493

            
2494
    $dbi->update(append => 'order by title');
2495

            
2496
=item C<filter>
2497

            
2498
Filter, executed before data is send to database. This is array reference.
2499
Filter value is code reference or
2500
filter name registerd by C<register_filter()>.
2501

            
2502
    # Basic
2503
    $dbi->update(
2504
        filter => [
2505
            title  => sub { uc $_[0] }
2506
            author => sub { uc $_[0] }
2507
        ]
2508
    );
2509
    
2510
    # At once
2511
    $dbi->update(
2512
        filter => [
2513
            [qw/title author/]  => sub { uc $_[0] }
2514
        ]
2515
    );
2516
    
2517
    # Filter name
2518
    $dbi->update(
2519
        filter => [
2520
            title  => 'upper_case',
2521
            author => 'upper_case'
2522
        ]
2523
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2524

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

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

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

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

            
2534
You can check SQL.
2535

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2538
=back
2539

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

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

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

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

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

            
2551
    $dbi->update_at(
2552
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2553
        primary_key => 'id',
2554
        where => '5',
2555
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2556
    );
2557

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2562
=over 4
2563

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

            
2566
Primary key. This is constant value or array reference.
2567
    
2568
    # Constant value
2569
    $dbi->update(primary_key => 'id');
2570

            
2571
    # Array reference
2572
    $dbi->update(primary_key => ['id1', 'id2' ]);
2573

            
2574
This is used to create where clause.
2575

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

            
2578
Where clause, created from primary key information.
2579
This is constant value or array reference.
2580

            
2581
    # Constant value
2582
    $dbi->update(where => 5);
2583

            
2584
    # Array reference
2585
    $dbi->update(where => [3, 5]);
2586

            
2587
In first examle, the following SQL is created.
2588

            
2589
    update book set title = ? where id = ?
2590

            
2591
Place holders are set to 'Perl' and 5.
2592

            
update pod
Yuki Kimoto authored on 2011-03-13
2593
=back
2594

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

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

            
2599
Create update parameter tag.
2600

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2605
    my $where = $dbi->where(
2606
        clause => ['and', '{= title}', '{= author}'],
2607
        param => {title => 'Perl', author => 'Ken'}
2608
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2609

            
2610
Create a new L<DBIx::Custom::Where> object.
2611

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2619
=head1 Tags
2620

            
2621
The following tags is available.
2622

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

            
2625
Table tag
2626

            
2627
    {table TABLE}    ->    TABLE
2628

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2631
=head2 C<?>
2632

            
2633
Placeholder tag.
2634

            
2635
    {? NAME}    ->   ?
2636

            
2637
=head2 C<=>
2638

            
2639
Equal tag.
2640

            
2641
    {= NAME}    ->   NAME = ?
2642

            
2643
=head2 C<E<lt>E<gt>>
2644

            
2645
Not equal tag.
2646

            
2647
    {<> NAME}   ->   NAME <> ?
2648

            
2649
=head2 C<E<lt>>
2650

            
2651
Lower than tag
2652

            
2653
    {< NAME}    ->   NAME < ?
2654

            
2655
=head2 C<E<gt>>
2656

            
2657
Greater than tag
2658

            
2659
    {> NAME}    ->   NAME > ?
2660

            
2661
=head2 C<E<gt>=>
2662

            
2663
Greater than or equal tag
2664

            
2665
    {>= NAME}   ->   NAME >= ?
2666

            
2667
=head2 C<E<lt>=>
2668

            
2669
Lower than or equal tag
2670

            
2671
    {<= NAME}   ->   NAME <= ?
2672

            
2673
=head2 C<like>
2674

            
2675
Like tag
2676

            
2677
    {like NAME}   ->   NAME like ?
2678

            
2679
=head2 C<in>
2680

            
2681
In tag.
2682

            
2683
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2684

            
2685
=head2 C<insert_param>
2686

            
2687
Insert parameter tag.
2688

            
2689
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2690

            
2691
=head2 C<update_param>
2692

            
2693
Updata parameter tag.
2694

            
2695
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2696

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

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

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

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

            
2706
C<< <kimoto.yuki at gmail.com> >>
2707

            
2708
L<http://github.com/yuki-kimoto/DBIx-Custom>
2709

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2710
=head1 AUTHOR
2711

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

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

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

            
2718
This program is free software; you can redistribute it and/or modify it
2719
under the same terms as Perl itself.
2720

            
2721
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2722

            
2723