DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2728 lines | 65.062kb
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 2011-03-21
243
our %DELETE_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
244
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
245

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

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

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

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

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

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

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

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

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

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

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

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

            
478
        return $result;
479
    }
480
    return $affected;
481
}
482

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1318
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1319
__PACKAGE__->attr(
1320
    dbi_options => sub { {} },
1321
    filter_check  => 1
1322
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1323

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1346
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1347
sub default_fetch_filter {
1348
    my $self = shift;
1349
    
1350
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1351
        my $fname = $_[0];
1352

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1369
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1370
sub register_tag_processor {
1371
    return shift->query_builder->register_tag_processor(@_);
1372
}
1373

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1412
=head1 NAME
1413

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

            
1416
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1417

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

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

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

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

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

            
1485
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1486

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1497
=item *
1498

            
1499
Filter when data is send or receive.
1500

            
1501
=item *
1502

            
1503
Data filtering system
1504

            
1505
=item *
1506

            
1507
Model support.
1508

            
1509
=item *
1510

            
1511
Generate where clause dinamically.
1512

            
1513
=item *
1514

            
1515
Generate join clause dinamically.
1516

            
1517
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1518

            
1519
=head1 GUIDE
1520

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1552
=head2 C<default_dbi_option>
1553

            
1554
    my $default_dbi_option = $dbi->default_dbi_option;
1555
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1556

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1560
    {
1561
        RaiseError => 1,
1562
        PrintError => 0,
1563
        AutoCommit => 1,
1564
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1565

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

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

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

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

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

            
1578
    my $models = $dbi->models;
1579
    $dbi       = $dbi->models(\%models);
1580

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1583
=head2 C<password>
1584

            
1585
    my $password = $dbi->password;
1586
    $dbi         = $dbi->password('lkj&le`@s');
1587

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1614
    my $user = $dbi->user;
1615
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1616

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1641
Apply filter to columns.
1642
C<out> filter is executed before data is send to database.
1643
C<in> filter is executed after a row is fetch.
1644
C<end> filter is execute after C<in> filter is executed.
1645

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1648
       PETTERN         EXAMPLE
1649
    1. Column        : author
1650
    2. Table.Column  : book.author
1651
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1652

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

            
1656
You can set multiple filters at once.
1657

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

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

            
1669
    $dbi          = $dbi->cache_method(\&cache_method);
1670
    $cache_method = $dbi->cache_method
1671

            
update pod
Yuki Kimoto authored on 2011-03-13
1672
Method to set and get cache.
1673
Default to the following one.
1674

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

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

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

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

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

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

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

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

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

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

            
1719
    my $dbh = $dbi->dbh;
1720
    $dbi    = $dbi->dbh($dbh);
1721

            
1722
Get and set database handle of L<DBI>.
1723

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1729
    my $result = $dbi->execute(
1730
        "select * from book where {= title} and {like author}",
1731
        param => {title => 'Perl', author => '%Ken%'}
1732
    );
1733

            
1734
Execute SQL, containing tags.
1735
Return value is L<DBIx::Custom::Result> in select statement, or
1736
the count of affected rows in insert, update, delete statement.
1737

            
1738
Tag is turned into the statement containing place holder
1739
before SQL is executed.
1740

            
1741
    select * from where title = ? and author like ?;
1742

            
1743
See also L<Tags/Tags>.
1744

            
1745
The following opitons are currently available.
1746

            
1747
=over 4
1748

            
1749
=item C<filter>
1750

            
1751
Filter, executed before data is send to database. This is array reference.
1752
Filter value is code reference or
1753
filter name registerd by C<register_filter()>.
1754

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

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

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

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

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

            
1789
Delete statement.
1790

            
1791
The following opitons are currently available.
1792

            
update pod
Yuki Kimoto authored on 2011-03-13
1793
=over 4
1794

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

            
1797
Table name.
1798

            
1799
    $dbi->delete(table => 'book');
1800

            
1801
=item C<where>
1802

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

            
1815
=item C<append>
1816

            
1817
Append statement to last of SQL. This is string.
1818

            
1819
    $dbi->delete(append => 'order by title');
1820

            
1821
=item C<filter>
1822

            
1823
Filter, executed before data is send to database. This is array reference.
1824
Filter value is code reference or
1825
filter name registerd by C<register_filter()>.
1826

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

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

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

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

            
1856
Create column clause. The follwoing column clause is created.
1857

            
1858
    book.author as book__author,
1859
    book.title as book__title
1860

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

            
1863
Get L<DBIx::Custom::Query> object instead of executing SQL.
1864
This is true or false value.
1865

            
1866
    my $query = $dbi->delete(query => 1);
1867

            
1868
You can check SQL.
1869

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1872
=back
1873

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

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

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

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

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

            
1885
    $dbi->delete_at(
1886
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1887
        primary_key => 'id',
1888
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1889
    );
1890

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1895
=over 4
1896

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1899
Primary key. This is constant value or array reference.
1900
    
1901
    # Constant value
1902
    $dbi->delete(primary_key => 'id');
1903

            
1904
    # Array reference
1905
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1906

            
1907
This is used to create where clause.
1908

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

            
1911
Where clause, created from primary key information.
1912
This is constant value or array reference.
1913

            
1914
    # Constant value
1915
    $dbi->delete(where => 5);
1916

            
1917
    # Array reference
1918
    $dbi->delete(where => [3, 5]);
1919

            
1920
In first examle, the following SQL is created.
1921

            
1922
    delete from book where id = ?;
1923

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1926
=back
1927

            
cleanup
yuki-kimoto authored on 2010-10-17
1928
=head2 C<insert>
1929

            
update pod
Yuki Kimoto authored on 2011-03-13
1930
    $dbi->insert(
1931
        table  => 'book', 
1932
        param  => {title => 'Perl', author => 'Ken'}
1933
    );
1934

            
1935
Insert statement.
1936

            
1937
The following opitons are currently available.
1938

            
update pod
Yuki Kimoto authored on 2011-03-13
1939
=over 4
1940

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

            
1943
Table name.
1944

            
1945
    $dbi->insert(table => 'book');
1946

            
1947
=item C<param>
1948

            
1949
Insert data. This is hash reference.
1950

            
1951
    $dbi->insert(param => {title => 'Perl'});
1952

            
1953
=item C<append>
1954

            
1955
Append statement to last of SQL. This is string.
1956

            
1957
    $dbi->insert(append => 'order by title');
1958

            
1959
=item C<filter>
1960

            
1961
Filter, executed before data is send to database. This is array reference.
1962
Filter value is code reference or
1963
filter name registerd by C<register_filter()>.
1964

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

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

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

            
1992
Get L<DBIx::Custom::Query> object instead of executing SQL.
1993
This is true or false value.
1994

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2001
=back
2002

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2018
=over 4
2019

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

            
2022
Primary key. This is constant value or array reference.
2023
    
2024
    # Constant value
2025
    $dbi->insert(primary_key => 'id');
2026

            
2027
    # Array reference
2028
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2029

            
2030
This is used to create parts of insert data.
2031

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

            
2034
Parts of Insert data, create from primary key information.
2035
This is constant value or array reference.
2036

            
2037
    # Constant value
2038
    $dbi->insert(where => 5);
2039

            
2040
    # Array reference
2041
    $dbi->insert(where => [3, 5]);
2042

            
2043
In first examle, the following SQL is created.
2044

            
2045
    insert into book (id, title) values (?, ?);
2046

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2049
=back
2050

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

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

            
2055
Create insert parameter tag.
2056

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2085
    lib / MyModel.pm
2086
        / MyModel / book.pm
2087
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2088

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

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

            
2093
    package MyModel;
2094
    
2095
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2096
    
2097
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2098

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2103
    package MyModel::book;
2104
    
2105
    use base 'MyModel';
2106
    
2107
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2108

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2111
    package MyModel::company;
2112
    
2113
    use base 'MyModel';
2114
    
2115
    1;
2116
    
2117
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2118

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

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

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

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

            
2128
    $dbi->method(
2129
        update_or_insert => 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
        find_or_create   => sub {
2135
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2136
            
2137
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2138
        }
2139
    );
2140

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

            
2143
    $dbi->update_or_insert;
2144
    $dbi->find_or_create;
2145

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

            
2148
    $dbi->model('book')->method(
2149
        insert => sub { ... },
2150
        update => sub { ... }
2151
    );
2152
    
2153
    my $model = $dbi->model('book');
2154

            
2155
Set and get a L<DBIx::Custom::Model> object,
2156

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

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

            
2161
Create column clause for myself. The follwoing column clause is created.
2162

            
2163
    book.author as author,
2164
    book.title as title
2165

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

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

            
2175
Create a new L<DBIx::Custom> object.
2176

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

            
2179
    my $not_exists = $dbi->not_exists;
2180

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2184
=head2 C<register_filter>
2185

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2247
The following opitons are currently available.
2248

            
2249
=over 4
2250

            
2251
=item C<table>
2252

            
2253
Table name.
2254

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

            
2257
=item C<column>
2258

            
2259
Column clause. This is array reference or constant value.
2260

            
2261
    # Hash refernce
2262
    $dbi->select(column => ['author', 'title']);
2263
    
2264
    # Constant value
2265
    $dbi->select(column => 'author');
2266

            
2267
Default is '*' unless C<column> is specified.
2268

            
2269
    # Default
2270
    $dbi->select(column => '*');
2271

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

            
2274
=over 4
2275

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

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

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

            
2282
If main table is C<book> and joined table is C<company>,
2283
This create the following column clause.
2284

            
2285
    book.author as author
2286
    book.company_id as company_id
2287
    company.id as company__id
2288
    company.name as company__name
2289

            
2290
Columns of main table is consist of only column name,
2291
Columns of joined table is consist of table and column name joined C<__>.
2292

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

            
2296
    # Generally do the following way before using all_column option
2297
    $dbi->include_model('MyModel')->setup_model;
2298

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

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

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

            
2305
=item prepend EXPERIMENTAL
2306

            
2307
You can add before created statement
2308

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

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

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

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

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

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

            
2331
    $dbi->select(join =>
2332
        [
2333
            'left outer join company on book.company_id = company_id',
2334
            'left outer join location on company.location_id = location.id'
2335
        ]
2336
    );
2337

            
2338
If column cluase or where clause contain table name like "company.name",
2339
needed join clause is used automatically.
2340

            
2341
    $dbi->select(
2342
        table => 'book',
2343
        column => ['company.location_id as company__location_id'],
2344
        where => {'company.name' => 'Orange'},
2345
        join => [
2346
            'left outer join company on book.company_id = company.id',
2347
            'left outer join location on company.location_id = location.id'
2348
        ]
2349
    );
2350

            
2351
In above select, the following SQL is created.
2352

            
2353
    select company.location_id as company__location_id
2354
    from book
2355
      left outer join company on book.company_id = company.id
2356
    where company.name = Orange
2357

            
2358
=item C<append>
2359

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

            
2362
    $dbi->select(append => 'order by title');
2363

            
2364
=item C<filter>
2365

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

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

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

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

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

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

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

            
2404
    my $sql = $query->sql;
2405

            
2406
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2407

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

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

            
2412
    $dbi->select_at(
2413
        table => 'book',
2414
        primary_key => 'id',
2415
        where => '5'
2416
    );
2417

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2422
=over 4
2423

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2426
Primary key. This is constant value or array reference.
2427
    
2428
    # Constant value
2429
    $dbi->select(primary_key => 'id');
2430

            
2431
    # Array reference
2432
    $dbi->select(primary_key => ['id1', 'id2' ]);
2433

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

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

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

            
2441
    # Constant value
2442
    $dbi->select(where => 5);
2443

            
2444
    # Array reference
2445
    $dbi->select(where => [3, 5]);
2446

            
2447
In first examle, the following SQL is created.
2448

            
2449
    select * from book where id = ?
2450

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2453
=back
2454

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2457
    $dbi->update(
2458
        table  => 'book',
2459
        param  => {title => 'Perl'},
2460
        where  => {id => 4}
2461
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2462

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2467
=over 4
2468

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2471
Table name.
2472

            
2473
    $dbi->update(table => 'book');
2474

            
2475
=item C<param>
2476

            
2477
Update data. This is hash reference.
2478

            
2479
    $dbi->update(param => {title => 'Perl'});
2480

            
2481
=item C<where>
2482

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

            
2495
=item C<append>
2496

            
2497
Append statement to last of SQL. This is string.
2498

            
2499
    $dbi->update(append => 'order by title');
2500

            
2501
=item C<filter>
2502

            
2503
Filter, executed before data is send to database. This is array reference.
2504
Filter value is code reference or
2505
filter name registerd by C<register_filter()>.
2506

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

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

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

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

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

            
2539
You can check SQL.
2540

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2543
=back
2544

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

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

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

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

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

            
2556
    $dbi->update_at(
2557
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2558
        primary_key => 'id',
2559
        where => '5',
2560
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2561
    );
2562

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2567
=over 4
2568

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

            
2571
Primary key. This is constant value or array reference.
2572
    
2573
    # Constant value
2574
    $dbi->update(primary_key => 'id');
2575

            
2576
    # Array reference
2577
    $dbi->update(primary_key => ['id1', 'id2' ]);
2578

            
2579
This is used to create where clause.
2580

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

            
2583
Where clause, created from primary key information.
2584
This is constant value or array reference.
2585

            
2586
    # Constant value
2587
    $dbi->update(where => 5);
2588

            
2589
    # Array reference
2590
    $dbi->update(where => [3, 5]);
2591

            
2592
In first examle, the following SQL is created.
2593

            
2594
    update book set title = ? where id = ?
2595

            
2596
Place holders are set to 'Perl' and 5.
2597

            
update pod
Yuki Kimoto authored on 2011-03-13
2598
=back
2599

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

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

            
2604
Create update parameter tag.
2605

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2610
    my $where = $dbi->where(
2611
        clause => ['and', '{= title}', '{= author}'],
2612
        param => {title => 'Perl', author => 'Ken'}
2613
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2614

            
2615
Create a new L<DBIx::Custom::Where> object.
2616

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2624
=head1 Tags
2625

            
2626
The following tags is available.
2627

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

            
2630
Table tag
2631

            
2632
    {table TABLE}    ->    TABLE
2633

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2636
=head2 C<?>
2637

            
2638
Placeholder tag.
2639

            
2640
    {? NAME}    ->   ?
2641

            
2642
=head2 C<=>
2643

            
2644
Equal tag.
2645

            
2646
    {= NAME}    ->   NAME = ?
2647

            
2648
=head2 C<E<lt>E<gt>>
2649

            
2650
Not equal tag.
2651

            
2652
    {<> NAME}   ->   NAME <> ?
2653

            
2654
=head2 C<E<lt>>
2655

            
2656
Lower than tag
2657

            
2658
    {< NAME}    ->   NAME < ?
2659

            
2660
=head2 C<E<gt>>
2661

            
2662
Greater than tag
2663

            
2664
    {> NAME}    ->   NAME > ?
2665

            
2666
=head2 C<E<gt>=>
2667

            
2668
Greater than or equal tag
2669

            
2670
    {>= NAME}   ->   NAME >= ?
2671

            
2672
=head2 C<E<lt>=>
2673

            
2674
Lower than or equal tag
2675

            
2676
    {<= NAME}   ->   NAME <= ?
2677

            
2678
=head2 C<like>
2679

            
2680
Like tag
2681

            
2682
    {like NAME}   ->   NAME like ?
2683

            
2684
=head2 C<in>
2685

            
2686
In tag.
2687

            
2688
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2689

            
2690
=head2 C<insert_param>
2691

            
2692
Insert parameter tag.
2693

            
2694
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2695

            
2696
=head2 C<update_param>
2697

            
2698
Updata parameter tag.
2699

            
2700
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2701

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

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

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

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

            
2711
C<< <kimoto.yuki at gmail.com> >>
2712

            
2713
L<http://github.com/yuki-kimoto/DBIx-Custom>
2714

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2715
=head1 AUTHOR
2716

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

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

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

            
2723
This program is free software; you can redistribute it and/or modify it
2724
under the same terms as Perl itself.
2725

            
2726
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2727

            
2728