DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2753 lines | 65.81kb
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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
486
        return $result;
487
    }
488
    return $affected;
489
}
490

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

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

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

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

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

            
565
        croak qq{"where" must be constant value or array reference}
566
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
567
        
568
        for(my $i = 0; $i < @$primary_keys; $i ++) {
569
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
570
        }
571
    }
572
    
573
    if (exists $args{param}) {
574
        $param = delete $args{param};
575
        for(my $i = 0; $i < @$primary_keys; $i ++) {
576
             delete $param->{$primary_keys->[$i]};
577
        }
578
    }
579
    
580
    $param = {%$param, %$where};
581
    
582
    return $self->insert(param => $param, %args);
583
}
584

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
699
sub method {
700
    my $self = shift;
701
    
702
    # Merge
703
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
704
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
705
    
706
    return $self;
707
}
708

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
709
sub model {
710
    my ($self, $name, $model) = @_;
711
    
712
    # Set
713
    if ($model) {
714
        $self->models->{$name} = $model;
715
        return $self;
716
    }
717
    
718
    # Check model existance
719
    croak qq{Model "$name" is not included}
720
      unless $self->models->{$name};
721
    
722
    # Get
723
    return $self->models->{$name};
724
}
725

            
cleanup
Yuki Kimoto authored on 2011-03-21
726
sub mycolumn {
727
    my ($self, $table, $columns) = @_;
728
    
729
    $columns ||= [];
730
    my @column;
731
    push @column, "$table.$_ as $_" for @$columns;
732
    
733
    return join (', ', @column);
734
}
735

            
added dbi_options attribute
kimoto authored on 2010-12-20
736
sub new {
737
    my $self = shift->SUPER::new(@_);
738
    
739
    # Check attribute names
740
    my @attrs = keys %$self;
741
    foreach my $attr (@attrs) {
742
        croak qq{"$attr" is invalid attribute name}
743
          unless $self->can($attr);
744
    }
cleanup
Yuki Kimoto authored on 2011-01-25
745

            
746
    $self->register_tag(
747
        '?'     => \&DBIx::Custom::Tag::placeholder,
748
        '='     => \&DBIx::Custom::Tag::equal,
749
        '<>'    => \&DBIx::Custom::Tag::not_equal,
750
        '>'     => \&DBIx::Custom::Tag::greater_than,
751
        '<'     => \&DBIx::Custom::Tag::lower_than,
752
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
753
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
754
        'like'  => \&DBIx::Custom::Tag::like,
755
        'in'    => \&DBIx::Custom::Tag::in,
756
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
757
        'update_param' => \&DBIx::Custom::Tag::update_param
758
    );
added dbi_options attribute
kimoto authored on 2010-12-20
759
    
760
    return $self;
761
}
762

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

            
cleanup
yuki-kimoto authored on 2010-10-17
765
sub register_filter {
766
    my $invocant = shift;
767
    
768
    # Register filter
769
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
770
    $invocant->filters({%{$invocant->filters}, %$filters});
771
    
772
    return $invocant;
773
}
packaging one directory
yuki-kimoto authored on 2009-11-16
774

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1109
sub update_at {
1110
    my ($self, %args) = @_;
1111
    
cleanup
Yuki Kimoto authored on 2011-03-09
1112
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1113
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1114
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1115
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1116
    }
1117
    
1118
    # Primary key
1119
    my $primary_keys = delete $args{primary_key};
1120
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1121
    
1122
    # Where clause
1123
    my $where = {};
1124
    my $param = {};
1125
    
1126
    if (exists $args{where}) {
1127
        my $where_columns = delete $args{where};
1128
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1129

            
1130
        croak qq{"where" must be constant value or array reference}
1131
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1132
        
1133
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1134
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1135
        }
1136
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1137
    
1138
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1139
        $param = delete $args{param};
1140
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1141
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1142
        }
1143
    }
1144
    
1145
    return $self->update(where => $where, param => $param, %args);
1146
}
1147

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1148
sub update_param {
1149
    my ($self, $param) = @_;
1150
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1151
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1152
    my @tag;
1153
    push @tag, '{update_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1154
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1155
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1156
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1157
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1158
        push @tag, $column;
1159
    }
1160
    push @tag, '}';
1161
    
1162
    return join ' ', @tag;
1163
}
1164

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

            
1168
    return DBIx::Custom::Where->new(
1169
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1170
        safety_character => $self->safety_character,
cleanup
Yuki Kimoto authored on 2011-03-09
1171
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1172
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1173
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1174

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

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1222
sub _connect {
1223
    my $self = shift;
1224
    
1225
    # Attributes
1226
    my $data_source = $self->data_source;
1227
    croak qq{"data_source" must be specified to connect()"}
1228
      unless $data_source;
1229
    my $user        = $self->user;
1230
    my $password    = $self->password;
1231
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1232
    
1233
    # Connect
1234
    my $dbh = eval {DBI->connect(
1235
        $data_source,
1236
        $user,
1237
        $password,
1238
        {
1239
            %{$self->default_dbi_option},
1240
            %$dbi_option
1241
        }
1242
    )};
1243
    
1244
    # Connect error
1245
    croak $@ if $@;
1246
    
1247
    return $dbh;
1248
}
1249

            
cleanup
yuki-kimoto authored on 2010-10-17
1250
sub _croak {
1251
    my ($self, $error, $append) = @_;
1252
    $append ||= "";
1253
    
1254
    # Verbose
1255
    if ($Carp::Verbose) { croak $error }
1256
    
1257
    # Not verbose
1258
    else {
1259
        
1260
        # Remove line and module infromation
1261
        my $at_pos = rindex($error, ' at ');
1262
        $error = substr($error, 0, $at_pos);
1263
        $error =~ s/\s+$//;
1264
        
1265
        croak "$error$append";
1266
    }
1267
}
1268

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1269
sub _need_tables {
1270
    my ($self, $tree, $need_tables, $tables) = @_;
1271
    
1272
    foreach my $table (@$tables) {
1273
        
1274
        if ($tree->{$table}) {
1275
            $need_tables->{$table} = 1;
1276
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1277
        }
1278
    }
1279
}
1280

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1281
sub _tables {
1282
    my ($self, $source) = @_;
1283
    
1284
    my $tables = [];
1285
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1286
    my $safety_character = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1287
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1288
    while ($source =~ /\b($safety_character+)\./g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1289
        push @$tables, $1;
1290
    }
1291
    
1292
    return $tables;
1293
}
1294

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1295
sub _push_join {
1296
    my ($self, $sql, $join, $join_tables) = @_;
1297
    
1298
    return unless @$join;
1299
    
1300
    my $tree = {};
1301
    
1302
    for (my $i = 0; $i < @$join; $i++) {
1303
        
1304
        my $join_clause = $join->[$i];
1305
        
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
1306
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1307
            
1308
            my $table1 = $1;
1309
            my $table2 = $2;
1310
            
1311
            croak qq{right side table of "$join_clause" must be uniq}
1312
              if exists $tree->{$table2};
1313
            
1314
            $tree->{$table2}
1315
              = {position => $i, parent => $table1, join => $join_clause};
1316
        }
1317
        else {
1318
            croak qq{join "$join_clause" must be two table name};
1319
        }
1320
    }
1321
    
1322
    my $need_tables = {};
1323
    $self->_need_tables($tree, $need_tables, $join_tables);
1324
    
1325
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1326

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1327
    foreach my $need_table (@need_tables) {
1328
        push @$sql, $tree->{$need_table}{join};
1329
    }
1330
}
cleanup
Yuki Kimoto authored on 2011-03-08
1331

            
cleanup
Yuki Kimoto authored on 2011-01-25
1332
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1333
__PACKAGE__->attr(
1334
    dbi_options => sub { {} },
1335
    filter_check  => 1
1336
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1337

            
cleanup
Yuki Kimoto authored on 2011-01-25
1338
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1339
sub default_bind_filter {
1340
    my $self = shift;
1341
    
1342
    if (@_) {
1343
        my $fname = $_[0];
1344
        
1345
        if (@_ && !$fname) {
1346
            $self->{default_out_filter} = undef;
1347
        }
1348
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1349
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1350
              unless exists $self->filters->{$fname};
1351
        
1352
            $self->{default_out_filter} = $self->filters->{$fname};
1353
        }
1354
        return $self;
1355
    }
1356
    
1357
    return $self->{default_out_filter};
1358
}
1359

            
cleanup
Yuki Kimoto authored on 2011-01-25
1360
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1361
sub default_fetch_filter {
1362
    my $self = shift;
1363
    
1364
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1365
        my $fname = $_[0];
1366

            
cleanup
Yuki Kimoto authored on 2011-01-12
1367
        if (@_ && !$fname) {
1368
            $self->{default_in_filter} = undef;
1369
        }
1370
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1371
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1372
              unless exists $self->filters->{$fname};
1373
        
1374
            $self->{default_in_filter} = $self->filters->{$fname};
1375
        }
1376
        
1377
        return $self;
1378
    }
1379
    
many changed
Yuki Kimoto authored on 2011-01-23
1380
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1381
}
1382

            
cleanup
Yuki Kimoto authored on 2011-01-25
1383
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1384
sub register_tag_processor {
1385
    return shift->query_builder->register_tag_processor(@_);
1386
}
1387

            
cleanup
Yuki Kimoto authored on 2011-03-08
1388
# DEPRECATED!
1389
sub _push_relation {
1390
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1391
    
1392
    if (keys %{$relation || {}}) {
1393
        push @$sql, $need_where ? 'where' : 'and';
1394
        foreach my $rcolumn (keys %$relation) {
1395
            my $table1 = (split (/\./, $rcolumn))[0];
1396
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1397
            push @$tables, ($table1, $table2);
1398
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1399
        }
1400
    }
1401
    pop @$sql if $sql->[-1] eq 'and';    
1402
}
1403

            
1404
# DEPRECATED!
1405
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1406
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1407
    
1408
    if (keys %{$relation || {}}) {
1409
        foreach my $rcolumn (keys %$relation) {
1410
            my $table1 = (split (/\./, $rcolumn))[0];
1411
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1412
            my $table1_exists;
1413
            my $table2_exists;
1414
            foreach my $table (@$tables) {
1415
                $table1_exists = 1 if $table eq $table1;
1416
                $table2_exists = 1 if $table eq $table2;
1417
            }
1418
            unshift @$tables, $table1 unless $table1_exists;
1419
            unshift @$tables, $table2 unless $table2_exists;
1420
        }
1421
    }
1422
}
1423

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1426
=head1 NAME
1427

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

            
1430
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1431

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1432
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1433
    
1434
    # Connect
1435
    my $dbi = DBIx::Custom->connect(
1436
        data_source => "dbi:mysql:database=dbname",
1437
        user => 'ken',
1438
        password => '!LFKD%$&',
1439
        dbi_option => {mysql_enable_utf8 => 1}
1440
    );
cleanup
yuki-kimoto authored on 2010-08-05
1441

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1442
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1443
    $dbi->insert(
1444
        table  => 'book',
1445
        param  => {title => 'Perl', author => 'Ken'}
1446
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1447
    
1448
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1449
    $dbi->update(
1450
        table  => 'book', 
1451
        param  => {title => 'Perl', author => 'Ken'}, 
1452
        where  => {id => 5},
1453
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1454
    
1455
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1456
    $dbi->delete(
1457
        table  => 'book',
1458
        where  => {author => 'Ken'},
1459
    );
cleanup
yuki-kimoto authored on 2010-08-05
1460

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

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

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

            
1499
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1500

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1505
There are many basic methods to execute various queries.
1506
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1507
C<delete_all()>, C<select()>,
1508
C<insert_at()>, C<update_at()>, 
1509
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1510

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1511
=item *
1512

            
1513
Filter when data is send or receive.
1514

            
1515
=item *
1516

            
1517
Data filtering system
1518

            
1519
=item *
1520

            
1521
Model support.
1522

            
1523
=item *
1524

            
1525
Generate where clause dinamically.
1526

            
1527
=item *
1528

            
1529
Generate join clause dinamically.
1530

            
1531
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1532

            
1533
=head1 GUIDE
1534

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1566
=head2 C<default_dbi_option>
1567

            
1568
    my $default_dbi_option = $dbi->default_dbi_option;
1569
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1570

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1574
    {
1575
        RaiseError => 1,
1576
        PrintError => 0,
1577
        AutoCommit => 1,
1578
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1579

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

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

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

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

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

            
1592
    my $models = $dbi->models;
1593
    $dbi       = $dbi->models(\%models);
1594

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

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

            
1599
    my $password = $dbi->password;
1600
    $dbi         = $dbi->password('lkj&le`@s');
1601

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1628
    my $user = $dbi->user;
1629
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1630

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1641
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1642
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1643
        'issue_date' => {
1644
            out => 'tp_to_date',
1645
            in  => 'date_to_tp',
1646
            end => 'tp_to_displaydate'
1647
        },
1648
        'write_date' => {
1649
            out => 'tp_to_date',
1650
            in  => 'date_to_tp',
1651
            end => 'tp_to_displaydate'
1652
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1653
    );
1654

            
update pod
Yuki Kimoto authored on 2011-03-13
1655
Apply filter to columns.
1656
C<out> filter is executed before data is send to database.
1657
C<in> filter is executed after a row is fetch.
1658
C<end> filter is execute after C<in> filter is executed.
1659

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1662
       PETTERN         EXAMPLE
1663
    1. Column        : author
1664
    2. Table.Column  : book.author
1665
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1666

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

            
1670
You can set multiple filters at once.
1671

            
1672
    $dbi->apply_filter(
1673
        'book',
1674
        [qw/issue_date write_date/] => {
1675
            out => 'tp_to_date',
1676
            in  => 'date_to_tp',
1677
            end => 'tp_to_displaydate'
1678
        }
1679
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1680

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

            
1683
    $dbi          = $dbi->cache_method(\&cache_method);
1684
    $cache_method = $dbi->cache_method
1685

            
update pod
Yuki Kimoto authored on 2011-03-13
1686
Method to set and get cache.
1687
Default to the following one.
1688

            
1689
    sub {
1690
        my $self = shift;
1691
        
1692
        $self->{_cached} ||= {};
1693
        
1694
        if (@_ > 1) {
1695
            $self->{_cached}{$_[0]} = $_[1];
1696
        }
1697
        else {
1698
            return $self->{_cached}{$_[0]};
1699
        }
1700
    }
update pod
Yuki Kimoto authored on 2011-03-13
1701

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1704
    my $dbi = DBIx::Custom->connect(
1705
        data_source => "dbi:mysql:database=dbname",
1706
        user => 'ken',
1707
        password => '!LFKD%$&',
1708
        dbi_option => {mysql_enable_utf8 => 1}
1709
    );
1710

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1717
=head2 C<create_query>
1718
    
1719
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1720
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1721
    );
update document
yuki-kimoto authored on 2009-11-19
1722

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

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

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

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

            
1733
    my $dbh = $dbi->dbh;
1734
    $dbi    = $dbi->dbh($dbh);
1735

            
1736
Get and set database handle of L<DBI>.
1737

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1743
    my $result = $dbi->execute(
1744
        "select * from book where {= title} and {like author}",
1745
        param => {title => 'Perl', author => '%Ken%'}
1746
    );
1747

            
1748
Execute SQL, containing tags.
1749
Return value is L<DBIx::Custom::Result> in select statement, or
1750
the count of affected rows in insert, update, delete statement.
1751

            
1752
Tag is turned into the statement containing place holder
1753
before SQL is executed.
1754

            
1755
    select * from where title = ? and author like ?;
1756

            
1757
See also L<Tags/Tags>.
1758

            
1759
The following opitons are currently available.
1760

            
1761
=over 4
1762

            
1763
=item C<filter>
1764

            
1765
Filter, executed before data is send to database. This is array reference.
1766
Filter value is code reference or
1767
filter name registerd by C<register_filter()>.
1768

            
1769
    # Basic
1770
    $dbi->execute(
1771
        $sql,
1772
        filter => [
1773
            title  => sub { uc $_[0] }
1774
            author => sub { uc $_[0] }
1775
        ]
1776
    );
1777
    
1778
    # At once
1779
    $dbi->execute(
1780
        $sql,
1781
        filter => [
1782
            [qw/title author/]  => sub { uc $_[0] }
1783
        ]
1784
    );
1785
    
1786
    # Filter name
1787
    $dbi->execute(
1788
        $sql,
1789
        filter => [
1790
            title  => 'upper_case',
1791
            author => 'upper_case'
1792
        ]
1793
    );
1794

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

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

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

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

            
1803
Delete statement.
1804

            
1805
The following opitons are currently available.
1806

            
update pod
Yuki Kimoto authored on 2011-03-13
1807
=over 4
1808

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

            
1811
Table name.
1812

            
1813
    $dbi->delete(table => 'book');
1814

            
1815
=item C<where>
1816

            
1817
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
1818
    
1819
    # Hash reference
1820
    $dbi->delete(where => {title => 'Perl'});
1821
    
1822
    # DBIx::Custom::Where object
1823
    my $where = $dbi->where(
1824
        clause => ['and', '{= author}', '{like title}'],
1825
        param  => {author => 'Ken', title => '%Perl%'}
1826
    );
1827
    $dbi->delete(where => $where);
1828

            
1829
=item C<append>
1830

            
1831
Append statement to last of SQL. This is string.
1832

            
1833
    $dbi->delete(append => 'order by title');
1834

            
1835
=item C<filter>
1836

            
1837
Filter, executed before data is send to database. This is array reference.
1838
Filter value is code reference or
1839
filter name registerd by C<register_filter()>.
1840

            
1841
    # Basic
1842
    $dbi->delete(
1843
        filter => [
1844
            title  => sub { uc $_[0] }
1845
            author => sub { uc $_[0] }
1846
        ]
1847
    );
1848
    
1849
    # At once
1850
    $dbi->delete(
1851
        filter => [
1852
            [qw/title author/]  => sub { uc $_[0] }
1853
        ]
1854
    );
1855
    
1856
    # Filter name
1857
    $dbi->delete(
1858
        filter => [
1859
            title  => 'upper_case',
1860
            author => 'upper_case'
1861
        ]
1862
    );
1863

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

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

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

            
1870
Create column clause. The follwoing column clause is created.
1871

            
1872
    book.author as book__author,
1873
    book.title as book__title
1874

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

            
1877
Get L<DBIx::Custom::Query> object instead of executing SQL.
1878
This is true or false value.
1879

            
1880
    my $query = $dbi->delete(query => 1);
1881

            
1882
You can check SQL.
1883

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1886
=back
1887

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

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

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

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

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

            
1899
    $dbi->delete_at(
1900
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1901
        primary_key => 'id',
1902
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1903
    );
1904

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1909
=over 4
1910

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1913
Primary key. This is constant value or array reference.
1914
    
1915
    # Constant value
1916
    $dbi->delete(primary_key => 'id');
1917

            
1918
    # Array reference
1919
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1920

            
1921
This is used to create where clause.
1922

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

            
1925
Where clause, created from primary key information.
1926
This is constant value or array reference.
1927

            
1928
    # Constant value
1929
    $dbi->delete(where => 5);
1930

            
1931
    # Array reference
1932
    $dbi->delete(where => [3, 5]);
1933

            
1934
In first examle, the following SQL is created.
1935

            
1936
    delete from book where id = ?;
1937

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1940
=back
1941

            
cleanup
yuki-kimoto authored on 2010-10-17
1942
=head2 C<insert>
1943

            
update pod
Yuki Kimoto authored on 2011-03-13
1944
    $dbi->insert(
1945
        table  => 'book', 
1946
        param  => {title => 'Perl', author => 'Ken'}
1947
    );
1948

            
1949
Insert statement.
1950

            
1951
The following opitons are currently available.
1952

            
update pod
Yuki Kimoto authored on 2011-03-13
1953
=over 4
1954

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

            
1957
Table name.
1958

            
1959
    $dbi->insert(table => 'book');
1960

            
1961
=item C<param>
1962

            
1963
Insert data. This is hash reference.
1964

            
1965
    $dbi->insert(param => {title => 'Perl'});
1966

            
1967
=item C<append>
1968

            
1969
Append statement to last of SQL. This is string.
1970

            
1971
    $dbi->insert(append => 'order by title');
1972

            
1973
=item C<filter>
1974

            
1975
Filter, executed before data is send to database. This is array reference.
1976
Filter value is code reference or
1977
filter name registerd by C<register_filter()>.
1978

            
1979
    # Basic
1980
    $dbi->insert(
1981
        filter => [
1982
            title  => sub { uc $_[0] }
1983
            author => sub { uc $_[0] }
1984
        ]
1985
    );
1986
    
1987
    # At once
1988
    $dbi->insert(
1989
        filter => [
1990
            [qw/title author/]  => sub { uc $_[0] }
1991
        ]
1992
    );
1993
    
1994
    # Filter name
1995
    $dbi->insert(
1996
        filter => [
1997
            title  => 'upper_case',
1998
            author => 'upper_case'
1999
        ]
2000
    );
2001

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

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

            
2006
Get L<DBIx::Custom::Query> object instead of executing SQL.
2007
This is true or false value.
2008

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

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

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

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

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

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

            
2021
    $dbi->insert_at(
2022
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2023
        primary_key => 'id',
2024
        where => '5',
2025
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2026
    );
2027

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2032
=over 4
2033

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

            
2036
Primary key. This is constant value or array reference.
2037
    
2038
    # Constant value
2039
    $dbi->insert(primary_key => 'id');
2040

            
2041
    # Array reference
2042
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2043

            
2044
This is used to create parts of insert data.
2045

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

            
2048
Parts of Insert data, create from primary key information.
2049
This is constant value or array reference.
2050

            
2051
    # Constant value
2052
    $dbi->insert(where => 5);
2053

            
2054
    # Array reference
2055
    $dbi->insert(where => [3, 5]);
2056

            
2057
In first examle, the following SQL is created.
2058

            
2059
    insert into book (id, title) values (?, ?);
2060

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2063
=back
2064

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

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

            
2069
Create insert parameter tag.
2070

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

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

            
pod fix
Yuki Kimoto authored on 2011-01-21
2075
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2076
        sub {
update pod
Yuki Kimoto authored on 2011-03-13
2077
            my ($dbi, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2078
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2079
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
2080
            
2081
            if ($type eq 'DATE') {
2082
                # ...
2083
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
2084
        }
2085
    );
update pod
Yuki Kimoto authored on 2011-03-13
2086

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2099
    lib / MyModel.pm
2100
        / MyModel / book.pm
2101
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2102

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

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

            
2107
    package MyModel;
2108
    
2109
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2110
    
2111
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2112

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2117
    package MyModel::book;
2118
    
2119
    use base 'MyModel';
2120
    
2121
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2122

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2125
    package MyModel::company;
2126
    
2127
    use base 'MyModel';
2128
    
2129
    1;
2130
    
2131
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2132

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

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

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

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

            
2142
    $dbi->method(
2143
        update_or_insert => sub {
2144
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2145
            
2146
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2147
        },
2148
        find_or_create   => sub {
2149
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2150
            
2151
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2152
        }
2153
    );
2154

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

            
2157
    $dbi->update_or_insert;
2158
    $dbi->find_or_create;
2159

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

            
2162
    $dbi->model('book')->method(
2163
        insert => sub { ... },
2164
        update => sub { ... }
2165
    );
2166
    
2167
    my $model = $dbi->model('book');
2168

            
2169
Set and get a L<DBIx::Custom::Model> object,
2170

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

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

            
2175
Create column clause for myself. The follwoing column clause is created.
2176

            
2177
    book.author as author,
2178
    book.title as title
2179

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2182
    my $dbi = DBIx::Custom->new(
2183
        data_source => "dbi:mysql:database=dbname",
2184
        user => 'ken',
2185
        password => '!LFKD%$&',
2186
        dbi_option => {mysql_enable_utf8 => 1}
2187
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2188

            
2189
Create a new L<DBIx::Custom> object.
2190

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

            
2193
    my $not_exists = $dbi->not_exists;
2194

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2198
=head2 C<register_filter>
2199

            
update pod
Yuki Kimoto authored on 2011-03-13
2200
    $dbi->register_filter(
2201
        # Time::Piece object to database DATE format
2202
        tp_to_date => sub {
2203
            my $tp = shift;
2204
            return $tp->strftime('%Y-%m-%d');
2205
        },
2206
        # database DATE format to Time::Piece object
2207
        date_to_tp => sub {
2208
           my $date = shift;
2209
           return Time::Piece->strptime($date, '%Y-%m-%d');
2210
        }
2211
    );
cleanup
yuki-kimoto authored on 2010-10-17
2212
    
update pod
Yuki Kimoto authored on 2011-03-13
2213
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2214

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2217
    $dbi->register_tag(
2218
        update => sub {
2219
            my @columns = @_;
2220
            
2221
            # Update parameters
2222
            my $s = 'set ';
2223
            $s .= "$_ = ?, " for @columns;
2224
            $s =~ s/, $//;
2225
            
2226
            return [$s, \@columns];
2227
        }
2228
    );
cleanup
yuki-kimoto authored on 2010-10-17
2229

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2253
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2254
        table  => 'book',
2255
        column => ['author', 'title'],
2256
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2257
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2258
    
update pod
Yuki Kimoto authored on 2011-03-12
2259
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2260

            
2261
The following opitons are currently available.
2262

            
2263
=over 4
2264

            
2265
=item C<table>
2266

            
2267
Table name.
2268

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

            
2271
=item C<column>
2272

            
2273
Column clause. This is array reference or constant value.
2274

            
2275
    # Hash refernce
2276
    $dbi->select(column => ['author', 'title']);
2277
    
2278
    # Constant value
2279
    $dbi->select(column => 'author');
2280

            
2281
Default is '*' unless C<column> is specified.
2282

            
2283
    # Default
2284
    $dbi->select(column => '*');
2285

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

            
2288
=over 4
2289

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

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

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

            
2296
If main table is C<book> and joined table is C<company>,
2297
This create the following column clause.
2298

            
2299
    book.author as author
2300
    book.company_id as company_id
2301
    company.id as company__id
2302
    company.name as company__name
2303

            
2304
Columns of main table is consist of only column name,
2305
Columns of joined table is consist of table and column name joined C<__>.
2306

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

            
2310
    # Generally do the following way before using all_column option
2311
    $dbi->include_model('MyModel')->setup_model;
2312

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

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

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

            
2319
=item prepend EXPERIMENTAL
2320

            
2321
You can add before created statement
2322

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

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

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

            
2329
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2330
    
2331
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2332
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2333
    
update pod
Yuki Kimoto authored on 2011-03-12
2334
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2335
    my $where = $dbi->where(
2336
        clause => ['and', '{= author}', '{like title}'],
2337
        param  => {author => 'Ken', title => '%Perl%'}
2338
    );
update pod
Yuki Kimoto authored on 2011-03-12
2339
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2340

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

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

            
2345
    $dbi->select(join =>
2346
        [
2347
            'left outer join company on book.company_id = company_id',
2348
            'left outer join location on company.location_id = location.id'
2349
        ]
2350
    );
2351

            
2352
If column cluase or where clause contain table name like "company.name",
2353
needed join clause is used automatically.
2354

            
2355
    $dbi->select(
2356
        table => 'book',
2357
        column => ['company.location_id as company__location_id'],
2358
        where => {'company.name' => 'Orange'},
2359
        join => [
2360
            'left outer join company on book.company_id = company.id',
2361
            'left outer join location on company.location_id = location.id'
2362
        ]
2363
    );
2364

            
2365
In above select, the following SQL is created.
2366

            
2367
    select company.location_id as company__location_id
2368
    from book
2369
      left outer join company on book.company_id = company.id
2370
    where company.name = Orange
2371

            
2372
=item C<append>
2373

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

            
2376
    $dbi->select(append => 'order by title');
2377

            
2378
=item C<filter>
2379

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

            
2384
    # Basic
2385
    $dbi->select(
2386
        filter => [
2387
            title  => sub { uc $_[0] }
2388
            author => sub { uc $_[0] }
2389
        ]
2390
    );
2391
    
2392
    # At once
2393
    $dbi->select(
2394
        filter => [
2395
            [qw/title author/]  => sub { uc $_[0] }
2396
        ]
2397
    );
2398
    
2399
    # Filter name
2400
    $dbi->select(
2401
        filter => [
2402
            title  => 'upper_case',
2403
            author => 'upper_case'
2404
        ]
2405
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2406

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

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

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

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

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

            
2418
    my $sql = $query->sql;
2419

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

            
2422
Specify database data type.
2423

            
2424
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2425
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2426

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

            
2429
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2430

            
update pod
Yuki Kimoto authored on 2011-03-12
2431
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2432

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

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

            
2437
    $dbi->select_at(
2438
        table => 'book',
2439
        primary_key => 'id',
2440
        where => '5'
2441
    );
2442

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2447
=over 4
2448

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2451
Primary key. This is constant value or array reference.
2452
    
2453
    # Constant value
2454
    $dbi->select(primary_key => 'id');
2455

            
2456
    # Array reference
2457
    $dbi->select(primary_key => ['id1', 'id2' ]);
2458

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

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

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

            
2466
    # Constant value
2467
    $dbi->select(where => 5);
2468

            
2469
    # Array reference
2470
    $dbi->select(where => [3, 5]);
2471

            
2472
In first examle, the following SQL is created.
2473

            
2474
    select * from book where id = ?
2475

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2478
=back
2479

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2482
    $dbi->update(
2483
        table  => 'book',
2484
        param  => {title => 'Perl'},
2485
        where  => {id => 4}
2486
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2487

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2492
=over 4
2493

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2496
Table name.
2497

            
2498
    $dbi->update(table => 'book');
2499

            
2500
=item C<param>
2501

            
2502
Update data. This is hash reference.
2503

            
2504
    $dbi->update(param => {title => 'Perl'});
2505

            
2506
=item C<where>
2507

            
2508
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
2509
    
2510
    # Hash reference
2511
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2512
    
2513
    # DBIx::Custom::Where object
2514
    my $where = $dbi->where(
2515
        clause => ['and', '{= author}', '{like title}'],
2516
        param  => {author => 'Ken', title => '%Perl%'}
2517
    );
2518
    $dbi->update(where => $where);
2519

            
2520
=item C<append>
2521

            
2522
Append statement to last of SQL. This is string.
2523

            
2524
    $dbi->update(append => 'order by title');
2525

            
2526
=item C<filter>
2527

            
2528
Filter, executed before data is send to database. This is array reference.
2529
Filter value is code reference or
2530
filter name registerd by C<register_filter()>.
2531

            
2532
    # Basic
2533
    $dbi->update(
2534
        filter => [
2535
            title  => sub { uc $_[0] }
2536
            author => sub { uc $_[0] }
2537
        ]
2538
    );
2539
    
2540
    # At once
2541
    $dbi->update(
2542
        filter => [
2543
            [qw/title author/]  => sub { uc $_[0] }
2544
        ]
2545
    );
2546
    
2547
    # Filter name
2548
    $dbi->update(
2549
        filter => [
2550
            title  => 'upper_case',
2551
            author => 'upper_case'
2552
        ]
2553
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2554

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

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

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

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

            
2564
You can check SQL.
2565

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2568
=back
2569

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

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

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

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

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

            
2581
    $dbi->update_at(
2582
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2583
        primary_key => 'id',
2584
        where => '5',
2585
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2586
    );
2587

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2592
=over 4
2593

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

            
2596
Primary key. This is constant value or array reference.
2597
    
2598
    # Constant value
2599
    $dbi->update(primary_key => 'id');
2600

            
2601
    # Array reference
2602
    $dbi->update(primary_key => ['id1', 'id2' ]);
2603

            
2604
This is used to create where clause.
2605

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

            
2608
Where clause, created from primary key information.
2609
This is constant value or array reference.
2610

            
2611
    # Constant value
2612
    $dbi->update(where => 5);
2613

            
2614
    # Array reference
2615
    $dbi->update(where => [3, 5]);
2616

            
2617
In first examle, the following SQL is created.
2618

            
2619
    update book set title = ? where id = ?
2620

            
2621
Place holders are set to 'Perl' and 5.
2622

            
update pod
Yuki Kimoto authored on 2011-03-13
2623
=back
2624

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

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

            
2629
Create update parameter tag.
2630

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2635
    my $where = $dbi->where(
2636
        clause => ['and', '{= title}', '{= author}'],
2637
        param => {title => 'Perl', author => 'Ken'}
2638
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2639

            
2640
Create a new L<DBIx::Custom::Where> object.
2641

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2649
=head1 Tags
2650

            
2651
The following tags is available.
2652

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

            
2655
Table tag
2656

            
2657
    {table TABLE}    ->    TABLE
2658

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2661
=head2 C<?>
2662

            
2663
Placeholder tag.
2664

            
2665
    {? NAME}    ->   ?
2666

            
2667
=head2 C<=>
2668

            
2669
Equal tag.
2670

            
2671
    {= NAME}    ->   NAME = ?
2672

            
2673
=head2 C<E<lt>E<gt>>
2674

            
2675
Not equal tag.
2676

            
2677
    {<> NAME}   ->   NAME <> ?
2678

            
2679
=head2 C<E<lt>>
2680

            
2681
Lower than tag
2682

            
2683
    {< NAME}    ->   NAME < ?
2684

            
2685
=head2 C<E<gt>>
2686

            
2687
Greater than tag
2688

            
2689
    {> NAME}    ->   NAME > ?
2690

            
2691
=head2 C<E<gt>=>
2692

            
2693
Greater than or equal tag
2694

            
2695
    {>= NAME}   ->   NAME >= ?
2696

            
2697
=head2 C<E<lt>=>
2698

            
2699
Lower than or equal tag
2700

            
2701
    {<= NAME}   ->   NAME <= ?
2702

            
2703
=head2 C<like>
2704

            
2705
Like tag
2706

            
2707
    {like NAME}   ->   NAME like ?
2708

            
2709
=head2 C<in>
2710

            
2711
In tag.
2712

            
2713
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2714

            
2715
=head2 C<insert_param>
2716

            
2717
Insert parameter tag.
2718

            
2719
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2720

            
2721
=head2 C<update_param>
2722

            
2723
Updata parameter tag.
2724

            
2725
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2726

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

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

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

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

            
2736
C<< <kimoto.yuki at gmail.com> >>
2737

            
2738
L<http://github.com/yuki-kimoto/DBIx-Custom>
2739

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2740
=head1 AUTHOR
2741

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

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

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

            
2748
This program is free software; you can redistribute it and/or modify it
2749
under the same terms as Perl itself.
2750

            
2751
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2752

            
2753