DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2723 lines | 64.956kb
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
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
420
    my $f = DBIx::Custom::Util::array_filter_to_hash($args{filter})
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;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
442
    eval {$affected = $sth->execute(@$bind)};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
443
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
444
    
445
    # Return resultset if select statement is executed
446
    if ($sth->{NUM_OF_FIELDS}) {
447
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
448
        # Result in and end filter
449
        my $in_filter  = {};
450
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
451
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
452
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
453
            $in_filter = {
454
                %$in_filter,
455
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
456
            };
457
            $end_filter = {
458
                %$end_filter,
459
                %{$self->{filter}{end}{$table} || {}}
460
            };
cleanup
Yuki Kimoto authored on 2011-01-12
461
        }
462
        
463
        # Result
464
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
465
            sth            => $sth,
466
            filters        => $self->filters,
467
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
468
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
469
            filter         => $in_filter || {},
470
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
471
        );
472

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1494
Filter when data is send or receive.
1495

            
1496
=item *
1497

            
1498
Data filtering system
1499

            
1500
=item *
1501

            
1502
Model support.
1503

            
1504
=item *
1505

            
1506
Generate where clause dinamically.
1507

            
1508
=item *
1509

            
1510
Generate join clause dinamically.
1511

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

            
1514
=head1 GUIDE
1515

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1547
=head2 C<default_dbi_option>
1548

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1651
You can set multiple filters at once.
1652

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1738
See also L<Tags/Tags>.
1739

            
1740
The following opitons are currently available.
1741

            
1742
=over 4
1743

            
1744
=item C<filter>
1745

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

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

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

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

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

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

            
1784
Delete statement.
1785

            
1786
The following opitons are currently available.
1787

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

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

            
1792
Table name.
1793

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

            
1796
=item C<where>
1797

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

            
1810
=item C<append>
1811

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

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

            
1816
=item C<filter>
1817

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

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

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

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

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

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

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

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

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

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

            
1863
You can check SQL.
1864

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1902
This is used to create where clause.
1903

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

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

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

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

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

            
1917
    delete from book where id = ?;
1918

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

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

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

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

            
1930
Insert statement.
1931

            
1932
The following opitons are currently available.
1933

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

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

            
1938
Table name.
1939

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

            
1942
=item C<param>
1943

            
1944
Insert data. This is hash reference.
1945

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

            
1948
=item C<append>
1949

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

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

            
1954
=item C<filter>
1955

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2050
Create insert parameter tag.
2051

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2242
The following opitons are currently available.
2243

            
2244
=over 4
2245

            
2246
=item C<table>
2247

            
2248
Table name.
2249

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

            
2252
=item C<column>
2253

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

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

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

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

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

            
2269
=over 4
2270

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

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

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

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

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

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

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

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

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

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

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

            
2300
=item prepend EXPERIMENTAL
2301

            
2302
You can add before created statement
2303

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

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

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

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

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

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

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

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

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

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

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

            
2353
=item C<append>
2354

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

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

            
2359
=item C<filter>
2360

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2444
    select * from book where id = ?
2445

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

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

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

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

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

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

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

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

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

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

            
2470
=item C<param>
2471

            
2472
Update data. This is hash reference.
2473

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

            
2476
=item C<where>
2477

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

            
2490
=item C<append>
2491

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

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

            
2496
=item C<filter>
2497

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

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

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

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

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

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

            
2534
You can check SQL.
2535

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2574
This is used to create where clause.
2575

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

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

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

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

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

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

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

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

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

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

            
2599
Create update parameter tag.
2600

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

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

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

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

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

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

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

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

            
2621
The following tags is available.
2622

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

            
2625
Table tag
2626

            
2627
    {table TABLE}    ->    TABLE
2628

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

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

            
2633
Placeholder tag.
2634

            
2635
    {? NAME}    ->   ?
2636

            
2637
=head2 C<=>
2638

            
2639
Equal tag.
2640

            
2641
    {= NAME}    ->   NAME = ?
2642

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

            
2645
Not equal tag.
2646

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

            
2649
=head2 C<E<lt>>
2650

            
2651
Lower than tag
2652

            
2653
    {< NAME}    ->   NAME < ?
2654

            
2655
=head2 C<E<gt>>
2656

            
2657
Greater than tag
2658

            
2659
    {> NAME}    ->   NAME > ?
2660

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

            
2663
Greater than or equal tag
2664

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

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

            
2669
Lower than or equal tag
2670

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

            
2673
=head2 C<like>
2674

            
2675
Like tag
2676

            
2677
    {like NAME}   ->   NAME like ?
2678

            
2679
=head2 C<in>
2680

            
2681
In tag.
2682

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

            
2685
=head2 C<insert_param>
2686

            
2687
Insert parameter tag.
2688

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

            
2691
=head2 C<update_param>
2692

            
2693
Updata parameter tag.
2694

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2723