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

            
cleanup
Yuki Kimoto authored on 2011-03-30
3
our $VERSION = '0.1667';
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/],
removed from cache() and cac...
Yuki Kimoto authored on 2011-03-29
26
    cache => 0,
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',
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
58
    reserved_word_quote => '',
update pod
Yuki Kimoto authored on 2011-03-13
59
    safety_character => '\w',
60
    stash => sub { {} }
fix tests
Yuki Kimoto authored on 2011-01-13
61
);
cleanup
yuki-kimoto authored on 2010-10-17
62

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

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
201
        # Bind
202
        my $columns = $query->columns;
203
        if (my $q = $self->reserved_word_quote) {
204
            foreach my $column (@$columns) {
205
                $column =~ s/$q//g;
206
            }
207
        }
208

            
cleanup
yuki-kimoto authored on 2010-10-17
209
        # Cache query
210
        $self->cache_method->($self, $source,
211
                             {sql     => $query->sql, 
add table tag
Yuki Kimoto authored on 2011-02-09
212
                              columns => $query->columns,
213
                              tables  => $query->tables})
cleanup
yuki-kimoto authored on 2010-10-17
214
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
215
    }
216
    
cleanup
yuki-kimoto authored on 2010-10-17
217
    # Prepare statement handle
218
    my $sth;
219
    eval { $sth = $self->dbh->prepare($query->{sql})};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
220
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
221
    
cleanup
yuki-kimoto authored on 2010-10-17
222
    # Set statement handle
223
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
224
    
cleanup
Yuki Kimoto authored on 2011-02-09
225
    # Set filters
226
    $query->filters($self->filters);
227
    
cleanup
yuki-kimoto authored on 2010-10-17
228
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
229
}
230

            
update pod
Yuki Kimoto authored on 2011-03-13
231
sub dbh {
232
    my $self = shift;
233

            
234
    if (@_) {
235
        $self->{dbh} = $_[0];
236
        return $self;
237
    }
238
    else {
239
        my $pid = $$;
240
        if ($self->pid eq $pid) {
241
            return $self->{dbh};
242
        }
243
        else {
244
            # Create new connection in child process
245
            croak "Process is forked in transaction"
246
              unless $self->{dbh}->{AutoCommit};
247
            $self->pid($pid);
248
            $self->{dbh}->{InactiveDestroy} = 1;
249
            return $self->{dbh} = $self->_connect;
250
        }
251
    }
252
}
253

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

            
cleanup
yuki-kimoto authored on 2010-10-17
257
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
258
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
259

            
260
    # Quote for reserved word
261
    my $q = $self->reserved_word_quote;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
262
    
cleanup
Yuki Kimoto authored on 2011-03-09
263
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
264
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
265
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
266
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
267
    }
268
    
269
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
270
    my $table = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
271
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
272
    my $where            = delete $args{where} || {};
273
    my $append           = delete $args{append};
274
    my $allow_delete_all = delete $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
275

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
276
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
277
    my $w = $self->_where($where);
278
    $where = $w->param;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
279
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
280
    # String where
281
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
282
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
283
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
284
      if $swhere eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
285

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

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

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
352
sub DESTROY { }
353

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
356
sub create_model {
357
    my $self = shift;
358
    
359
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
360
    $args->{dbi} = $self;
361
    
362
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
363
    my $model_name  = delete $args->{name};
364
    my $model_table = delete $args->{table};
365
    $model_name ||= $model_table;
366
    
367
    my $model = $model_class->new($args);
368
    $model->name($model_name) unless $model->name;
369
    $model->table($model_table) unless $model->table;
370
    
371
    # Apply filter
372
    croak "$model_class filter must be array reference"
373
      unless ref $model->filter eq 'ARRAY';
374
    $self->apply_filter($model->table, @{$model->filter});
375
    
376
    # Table - Model
377
    croak "Table name is duplicated"
378
      if exists $self->{_model_from}->{$model->table};
379
    $self->{_model_from}->{$model->table} = $model->name;
380

            
381
    # Table alias
382
    $self->{_table_alias} ||= {};
383
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
384
    
385
    # Set model
386
    $self->model($model->name, $model);
387
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
388
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
389
}
390

            
391
sub each_column {
392
    my ($self, $cb) = @_;
393
    
394
    # Iterate all tables
395
    my $sth_tables = $self->dbh->table_info;
396
    while (my $table_info = $sth_tables->fetchrow_hashref) {
397
        
398
        # Table
399
        my $table = $table_info->{TABLE_NAME};
400
        
401
        # Iterate all columns
402
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
403
        while (my $column_info = $sth_columns->fetchrow_hashref) {
404
            my $column = $column_info->{COLUMN_NAME};
405
            $self->$cb($table, $column, $column_info);
406
        }
407
    }
408
}
409

            
cleanup
yuki-kimoto authored on 2010-10-17
410
sub execute{
411
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
412
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
413
    # Quote for reserved word
414
    my $q = $self->reserved_word_quote;
415
    
cleanup
Yuki Kimoto authored on 2011-03-09
416
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
417
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
418
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
419
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
420
    }
421
    
cleanup
yuki-kimoto authored on 2010-10-17
422
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
423
    
cleanup
yuki-kimoto authored on 2010-10-17
424
    # First argument is the soruce of SQL
425
    $query = $self->create_query($query)
426
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
427
    
add table tag
Yuki Kimoto authored on 2011-02-09
428
    # Applied filter
cleanup
Yuki Kimoto authored on 2011-01-12
429
    my $filter = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
430
    
add table tag
Yuki Kimoto authored on 2011-02-09
431
    my $tables = $query->tables;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
432
    if ($q) {
433
        foreach my $table (@$tables) {
434
            $table =~ s/$q//g;
435
        }
436
    }
add table tag
Yuki Kimoto authored on 2011-02-09
437
    my $arg_tables = $args{table} || [];
438
    $arg_tables = [$arg_tables]
439
      unless ref $arg_tables eq 'ARRAY';
440
    push @$tables, @$arg_tables;
cleanup
Yuki Kimoto authored on 2011-03-09
441

            
442
    # Organize tables
443
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
444
    my $main_table = pop @$tables;
445
    delete $table_set{$main_table} if $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
446
    foreach my $table (keys %table_set) {
447
        push @$tables, $table;
448
        
449
        if (my $dist = $self->{_table_alias}->{$table}) {
450
            $self->{filter} ||= {};
451
            
452
            unless ($self->{filter}{out}{$table}) {
453
                $self->{filter}{out} ||= {};
454
                $self->{filter}{in}  ||= {};
455
                $self->{filter}{end} ||= {};
456
                
457
                foreach my $type (qw/out in end/) {
458
                    
459
                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {
460
                        my $filter_name_alias = $filter_name;
461
                        $filter_name_alias =~ s/^$dist\./$table\./;
462
                        $filter_name_alias =~ s/^${dist}__/${table}__/; 
463
                        
464
                        $self->{filter}{$type}{$table}{$filter_name_alias}
465
                          = $self->{filter}{$type}{$dist}{$filter_name}
466
                    }
467
                }
468
            }
469
        }
470
    }
471
    
cleanup
Yuki Kimoto authored on 2011-03-09
472
    $tables = [keys %table_set];
473
    push @$tables, $main_table if $main_table;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
474
    
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
475
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
476
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
477
        $filter = {
478
            %$filter,
479
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
480
        }
481
    }
482
    
cleanup
Yuki Kimoto authored on 2011-01-12
483
    # Filter argument
cleanup
Yuki Kimoto authored on 2011-03-21
484
    my $f = DBIx::Custom::Util::array_to_hash($args{filter})
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
485
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
486
    foreach my $column (keys %$f) {
487
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
488
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
489
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
490
        }
491
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
492
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
493
            unless exists $self->filters->{$fname};
494
          
cleanup
Yuki Kimoto authored on 2011-01-12
495
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
496
        }
497
    }
cleanup
Yuki Kimoto authored on 2011-01-12
498
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
499
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
500
    # Type
501
    my $type = DBIx::Custom::Util::array_to_hash($args{type});
502
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
503
    # Bind
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
504
    my $bind = $self->_bind($params, $query->columns, $filter, $type);
cleanup
yuki-kimoto authored on 2010-10-17
505
    
506
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
507
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
508
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
509
    eval {
510
        for (my $i = 0; $i < @$bind; $i++) {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
511
            if (my $type = $bind->[$i]->{type}) {
512
                $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);
513
            }
514
            else {
515
                $sth->bind_param($i + 1, $bind->[$i]->{value});
516
            }
cleanup
Yuki Kimoto authored on 2011-03-21
517
        }
518
        $affected = $sth->execute;
519
    };
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
520
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
521
    
522
    # Return resultset if select statement is executed
523
    if ($sth->{NUM_OF_FIELDS}) {
524
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
525
        # Result in and end filter
526
        my $in_filter  = {};
527
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
528
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
529
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
530
            $in_filter = {
531
                %$in_filter,
532
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
533
            };
534
            $end_filter = {
535
                %$end_filter,
536
                %{$self->{filter}{end}{$table} || {}}
537
            };
cleanup
Yuki Kimoto authored on 2011-01-12
538
        }
539
        
540
        # Result
541
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
542
            sth            => $sth,
543
            filters        => $self->filters,
544
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
545
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
546
            filter         => $in_filter || {},
547
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
548
        );
549

            
550
        return $result;
551
    }
552
    return $affected;
553
}
554

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

            
cleanup
yuki-kimoto authored on 2010-10-17
557
sub insert {
558
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
559
    
560
    # Quote for reserved word
561
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
562

            
cleanup
Yuki Kimoto authored on 2011-03-09
563
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
564
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
565
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
566
          unless $INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
567
    }
568
    
cleanup
yuki-kimoto authored on 2010-10-17
569
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
570
    my $table  = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
571
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
572
    my $param  = delete $args{param} || {};
573
    my $append = delete $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
574
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
575
    # Columns
576
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
577
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
578
    foreach my $column (keys %$param) {
579
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
580
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
581
          $column = "$q$column$q";
582
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
583
        push @columns, $column;
584
    }
cleanup
yuki-kimoto authored on 2010-10-17
585
    
cleanup
Yuki Kimoto authored on 2011-01-27
586
    # SQL stack
587
    my @sql;
588
    
589
    # Insert
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
590
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
591
    push @sql, $append if $append;
592
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
593
    # SQL
cleanup
Yuki Kimoto authored on 2011-01-27
594
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
595
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
596
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
597
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
598
    return $query if $args{query};
599
    
packaging one directory
yuki-kimoto authored on 2009-11-16
600
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
601
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
602
        $query,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
603
        param  => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
604
        table => $table,
605
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
606
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
607
    
608
    return $ret_val;
609
}
610

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

            
613
sub insert_at {
614
    my ($self, %args) = @_;
615
    
cleanup
Yuki Kimoto authored on 2011-03-09
616
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
617
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
618
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
619
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
620
    }
621
    
622
    # Primary key
623
    my $primary_keys = delete $args{primary_key};
624
    $primary_keys = [$primary_keys] unless ref $primary_keys;
625
    
626
    # Where clause
627
    my $where = {};
628
    my $param = {};
629
    
630
    if (exists $args{where}) {
631
        my $where_columns = delete $args{where};
632
        $where_columns = [$where_columns] unless ref $where_columns;
633

            
634
        croak qq{"where" must be constant value or array reference}
635
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
636
        
637
        for(my $i = 0; $i < @$primary_keys; $i ++) {
638
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
639
        }
640
    }
641
    
642
    if (exists $args{param}) {
643
        $param = delete $args{param};
644
        for(my $i = 0; $i < @$primary_keys; $i ++) {
645
             delete $param->{$primary_keys->[$i]};
646
        }
647
    }
648
    
649
    $param = {%$param, %$where};
650
    
651
    return $self->insert(param => $param, %args);
652
}
653

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
654
sub insert_param {
655
    my ($self, $param) = @_;
656
    
update pod
Yuki Kimoto authored on 2011-03-13
657
    # Insert parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
658
    my @tag;
659
    push @tag, '{insert_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
660
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
661
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
662
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
663
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
664
        push @tag, $column;
665
    }
666
    push @tag, '}';
667
    
668
    return join ' ', @tag;
669
}
670

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
671
sub include_model {
672
    my ($self, $name_space, $model_infos) = @_;
673
    
674
    $name_space ||= '';
675
    unless ($model_infos) {
676
        # Load name space module
677
        croak qq{"$name_space" is invalid class name}
678
          if $name_space =~ /[^\w:]/;
679
        eval "use $name_space";
680
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
681
        
682
        # Search model modules
683
        my $path = $INC{"$name_space.pm"};
684
        $path =~ s/\.pm$//;
685
        opendir my $dh, $path
686
          or croak qq{Can't open directory "$path": $!};
687
        $model_infos = [];
688
        while (my $module = readdir $dh) {
689
            push @$model_infos, $module
690
              if $module =~ s/\.pm$//;
691
        }
692
        
693
        close $dh;
694
    }
695
    
696
    foreach my $model_info (@$model_infos) {
697
        
698
        # Model class, name, table
699
        my $model_class;
700
        my $model_name;
701
        my $model_table;
702
        if (ref $model_info eq 'HASH') {
703
            $model_class = $model_info->{class};
704
            $model_name  = $model_info->{name};
705
            $model_table = $model_info->{table};
706
            
707
            $model_name  ||= $model_class;
708
            $model_table ||= $model_name;
709
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
710
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
711
        my $mclass = "${name_space}::$model_class";
712
        
713
        # Load
714
        croak qq{"$mclass" is invalid class name}
715
          if $mclass =~ /[^\w:]/;
716
        unless ($mclass->can('isa')) {
717
            eval "use $mclass";
718
            croak $@ if $@;
719
        }
720
        
721
        # Instantiate
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
722
        my $args = {};
723
        $args->{model_class} = $mclass if $mclass;
724
        $args->{name}        = $model_name if $model_name;
725
        $args->{table}       = $model_table if $model_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
726
        
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
727
        # Create model
728
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
729
    }
730
    
731
    return $self;
732
}
733

            
cleanup
Yuki Kimoto authored on 2011-03-21
734
sub method {
735
    my $self = shift;
736
    
737
    # Merge
738
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
739
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
740
    
741
    return $self;
742
}
743

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
744
sub model {
745
    my ($self, $name, $model) = @_;
746
    
747
    # Set
748
    if ($model) {
749
        $self->models->{$name} = $model;
750
        return $self;
751
    }
752
    
753
    # Check model existance
754
    croak qq{Model "$name" is not included}
755
      unless $self->models->{$name};
756
    
757
    # Get
758
    return $self->models->{$name};
759
}
760

            
cleanup
Yuki Kimoto authored on 2011-03-21
761
sub mycolumn {
762
    my ($self, $table, $columns) = @_;
763
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
764
    my $q = $self->reserved_word_quote;
765
    
cleanup
Yuki Kimoto authored on 2011-03-21
766
    $columns ||= [];
767
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
768
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
769
    
770
    return join (', ', @column);
771
}
772

            
added dbi_options attribute
kimoto authored on 2010-12-20
773
sub new {
774
    my $self = shift->SUPER::new(@_);
775
    
776
    # Check attribute names
777
    my @attrs = keys %$self;
778
    foreach my $attr (@attrs) {
779
        croak qq{"$attr" is invalid attribute name}
780
          unless $self->can($attr);
781
    }
cleanup
Yuki Kimoto authored on 2011-01-25
782

            
783
    $self->register_tag(
784
        '?'     => \&DBIx::Custom::Tag::placeholder,
785
        '='     => \&DBIx::Custom::Tag::equal,
786
        '<>'    => \&DBIx::Custom::Tag::not_equal,
787
        '>'     => \&DBIx::Custom::Tag::greater_than,
788
        '<'     => \&DBIx::Custom::Tag::lower_than,
789
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
790
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
791
        'like'  => \&DBIx::Custom::Tag::like,
792
        'in'    => \&DBIx::Custom::Tag::in,
793
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
794
        'update_param' => \&DBIx::Custom::Tag::update_param
795
    );
added dbi_options attribute
kimoto authored on 2010-12-20
796
    
797
    return $self;
798
}
799

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

            
cleanup
yuki-kimoto authored on 2010-10-17
802
sub register_filter {
803
    my $invocant = shift;
804
    
805
    # Register filter
806
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
807
    $invocant->filters({%{$invocant->filters}, %$filters});
808
    
809
    return $invocant;
810
}
packaging one directory
yuki-kimoto authored on 2009-11-16
811

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
817
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
818
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
819

            
820
    # Quote for reserved word
821
    my $q = $self->reserved_word_quote;
packaging one directory
yuki-kimoto authored on 2009-11-16
822
    
cleanup
Yuki Kimoto authored on 2011-03-09
823
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
824
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
825
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
826
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
827
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
828
    
refactoring select
yuki-kimoto authored on 2010-04-28
829
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
830
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
831
    my $tables = ref $table eq 'ARRAY' ? $table
832
               : defined $table ? [$table]
833
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
834
    my $columns   = delete $args{column};
835
    my $where     = delete $args{where} || {};
836
    my $append    = delete $args{append};
837
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
838
    croak qq{"join" must be array reference}
839
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
840
    my $relation = delete $args{relation};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
841
    
cleanup
Yuki Kimoto authored on 2011-03-09
842
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
843
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
844
    
cleanup
Yuki Kimoto authored on 2011-01-27
845
    # SQL stack
846
    my @sql;
847
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
848
    
cleanup
Yuki Kimoto authored on 2011-03-30
849
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
850

            
851
        $columns = [$columns] if ! ref $columns;
852
        
853
        if (ref $columns eq 'HASH') {
854
            # Find tables
855
            my $main_table;
856
            my %tables;
857
            if ($columns->{table}) {
858
                foreach my $table (@{$columns->{table}}) {
859
                    if (($table || '') eq $tables->[-1]) {
860
                        $main_table = $table;
861
                    }
862
                    else {
863
                        $tables{$table} = 1;
864
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
865
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
866
            }
867
            elsif ($columns->{all}) {
868
                $main_table = $tables->[-1] || '';
869
                foreach my $j (@$join) {
870
                    my $tables = $self->_tables($j);
871
                    foreach my $table (@$tables) {
872
                        $tables{$table} = 1;
873
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
874
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
875
                delete $tables{$main_table};
876
            }
877
            
878
            push @sql, $columns->{prepend} if $columns->{prepend};
879
            
880
            # Column clause of main table
881
            if ($main_table) {
cleanup
Yuki Kimoto authored on 2011-03-21
882
                push @sql, $self->model($main_table)->mycolumn;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
883
                push @sql, ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
884
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
885
            
886
            # Column cluase of other tables
887
            foreach my $table (keys %tables) {
888
                unshift @$tables, $table;
cleanup
Yuki Kimoto authored on 2011-03-21
889
                push @sql, $self->model($table)->column($table);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
890
                push @sql, ',';
891
            }
892
            pop @sql if $sql[-1] eq ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
893
        }
894
        else {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
895
            foreach my $column (@$columns) {
896
                unshift @$tables, @{$self->_tables($column)};
897
                push @sql, ($column, ',');
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
898
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
899
            pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
900
        }
901
    }
902
    
903
    # "*" is default
904
    else { push @sql, '*' }
905
    
906
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
907
    push @sql, 'from';
908
    if ($relation) {
909
        my $found = {};
910
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
911
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
912
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
913
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
914
    }
cleanup
Yuki Kimoto authored on 2011-03-30
915
    else {
916
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
917
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
918
    }
919
    pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
920
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
921
    # Main table
922
    croak "Not found table name" unless $tables->[-1];
923
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
924
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
925
    my $w = $self->_where($where);
926
    $where = $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
927
    
928
    # String where
929
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
930
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
931
    # Add table names in where clause
932
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
933
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
934
    # Push join
935
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
936
    
cleanup
Yuki Kimoto authored on 2011-03-09
937
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
938
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
939
    
cleanup
Yuki Kimoto authored on 2011-03-08
940
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
941
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
942
    
cleanup
Yuki Kimoto authored on 2011-01-27
943
    # Append statement
944
    push @sql, $append if $append;
945
    
946
    # SQL
947
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
948
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
949
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
950
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
951
    return $query if $args{query};
952
    
packaging one directory
yuki-kimoto authored on 2009-11-16
953
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
954
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
955
        $query,
956
        param  => $where, 
957
        table => $tables,
958
        %args
959
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
960
    
961
    return $result;
962
}
963

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1008
sub setup_model {
1009
    my $self = shift;
1010
    
1011
    $self->each_column(
1012
        sub {
1013
            my ($self, $table, $column, $column_info) = @_;
1014
            
1015
            if (my $model = $self->models->{$table}) {
1016
                push @{$model->columns}, $column;
1017
            }
1018
        }
1019
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1020
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1021
}
1022

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

            
1026
sub update {
1027
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1028

            
1029
    # Quote for reserved word
1030
    my $q = $self->reserved_word_quote;
version 0.0901
yuki-kimoto authored on 2009-12-17
1031
    
cleanup
Yuki Kimoto authored on 2011-03-09
1032
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1033
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1034
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1035
          unless $UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1036
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1037
    
cleanup
yuki-kimoto authored on 2010-10-17
1038
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1039
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1040
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1041
    my $param            = delete $args{param} || {};
1042
    my $where            = delete $args{where} || {};
1043
    my $append           = delete $args{append} || '';
1044
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1045
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1046
    # Columns
1047
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1048
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1049
    foreach my $column (keys %$param) {
1050
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1051
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1052
          $column = "$q$column$q";
1053
          $column =~ s/\./$q.$q/;
1054
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1055
    }
1056
        
cleanup
yuki-kimoto authored on 2010-10-17
1057
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1058
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1059

            
1060
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1061
    my $w = $self->_where($where);
1062
    $where = $w->param;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1063
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1064
    # String where
1065
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1066
    
1067
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1068
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1069
    
cleanup
Yuki Kimoto authored on 2011-01-27
1070
    # SQL stack
1071
    my @sql;
1072
    
1073
    # Update
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1074
    push @sql, "update $q$table$q $update_clause $swhere";
cleanup
Yuki Kimoto authored on 2011-01-27
1075
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1076
    
cleanup
yuki-kimoto authored on 2010-10-17
1077
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1078
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1079
        
cleanup
yuki-kimoto authored on 2010-10-17
1080
        if (exists $param->{$wkey}) {
1081
            $param->{$wkey} = [$param->{$wkey}]
1082
              unless ref $param->{$wkey} eq 'ARRAY';
1083
            
1084
            push @{$param->{$wkey}}, $where->{$wkey};
1085
        }
1086
        else {
1087
            $param->{$wkey} = $where->{$wkey};
1088
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1089
    }
cleanup
yuki-kimoto authored on 2010-10-17
1090
    
cleanup
Yuki Kimoto authored on 2011-01-27
1091
    # SQL
1092
    my $sql = join(' ', @sql);
1093
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1094
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1095
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1096
    return $query if $args{query};
1097
    
cleanup
yuki-kimoto authored on 2010-10-17
1098
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1099
    my $ret_val = $self->execute(
1100
        $query,
1101
        param  => $param, 
1102
        table => $table,
1103
        %args
1104
    );
cleanup
yuki-kimoto authored on 2010-10-17
1105
    
1106
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1107
}
1108

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

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

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

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

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

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

            
1172
    return DBIx::Custom::Where->new(
1173
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1174
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1175
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1176
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1177
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1178
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1179

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

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

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

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

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1286
sub _tables {
1287
    my ($self, $source) = @_;
1288
    
1289
    my $tables = [];
1290
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1291
    my $safety_character = $self->safety_character;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1292
    my $q = $self->reserved_word_quote;
1293
    my $q_re = quotemeta($q);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1294
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1295
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1296
                      : qr/\b([$safety_character]+)\./;
1297
    while ($source =~ /$table_re/g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1298
        push @$tables, $1;
1299
    }
1300
    
1301
    return $tables;
1302
}
1303

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1304
sub _push_join {
1305
    my ($self, $sql, $join, $join_tables) = @_;
1306
    
1307
    return unless @$join;
1308
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1309
    my $q = $self->reserved_word_quote;
1310
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1311
    my $tree = {};
1312
    
1313
    for (my $i = 0; $i < @$join; $i++) {
1314
        
1315
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1316
        my $q_re = quotemeta($q);
1317
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1318
                         : qr/\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/;
1319
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1320
            
1321
            my $table1 = $1;
1322
            my $table2 = $2;
1323
            
1324
            croak qq{right side table of "$join_clause" must be uniq}
1325
              if exists $tree->{$table2};
1326
            
1327
            $tree->{$table2}
1328
              = {position => $i, parent => $table1, join => $join_clause};
1329
        }
1330
        else {
1331
            croak qq{join "$join_clause" must be two table name};
1332
        }
1333
    }
1334
    
1335
    my $need_tables = {};
1336
    $self->_need_tables($tree, $need_tables, $join_tables);
1337
    
1338
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1339

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1340
    foreach my $need_table (@need_tables) {
1341
        push @$sql, $tree->{$need_table}{join};
1342
    }
1343
}
cleanup
Yuki Kimoto authored on 2011-03-08
1344

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1345
sub _where {
1346
    my ($self, $where) = @_;
1347
    
1348
    my $w;
1349
    if (ref $where eq 'HASH') {
1350
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1351
        my $q = $self->reserved_word_quote;
1352
        foreach my $column (keys %$where) {
1353
            $column = "$q$column$q";
1354
            $column =~ s/\./$q.$q/;
1355
            push @$clause, "{= $column}" for keys %$where;
1356
        }
1357
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1358
        $w = $self->where(clause => $clause, param => $where);
1359
    }
1360
    elsif (ref $where eq 'DBIx::Custom::Where') {
1361
        $w = $where;
1362
    }
1363
    elsif (ref $where eq 'ARRAY') {
1364
        $w = $self->where(
1365
            clause => $where->[0],
1366
            param  => $where->[1]
1367
        );
1368
    }
1369
    
1370
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1371
          qq{or array reference, which contains where clause and paramter}
1372
      unless ref $w eq 'DBIx::Custom::Where';
1373
    
1374
    return $w;
1375
}
1376

            
cleanup
Yuki Kimoto authored on 2011-01-25
1377
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1378
__PACKAGE__->attr(
1379
    dbi_options => sub { {} },
1380
    filter_check  => 1
1381
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1382

            
cleanup
Yuki Kimoto authored on 2011-01-25
1383
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1384
sub default_bind_filter {
1385
    my $self = shift;
1386
    
1387
    if (@_) {
1388
        my $fname = $_[0];
1389
        
1390
        if (@_ && !$fname) {
1391
            $self->{default_out_filter} = undef;
1392
        }
1393
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1394
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1395
              unless exists $self->filters->{$fname};
1396
        
1397
            $self->{default_out_filter} = $self->filters->{$fname};
1398
        }
1399
        return $self;
1400
    }
1401
    
1402
    return $self->{default_out_filter};
1403
}
1404

            
cleanup
Yuki Kimoto authored on 2011-01-25
1405
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1406
sub default_fetch_filter {
1407
    my $self = shift;
1408
    
1409
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1410
        my $fname = $_[0];
1411

            
cleanup
Yuki Kimoto authored on 2011-01-12
1412
        if (@_ && !$fname) {
1413
            $self->{default_in_filter} = undef;
1414
        }
1415
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1416
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1417
              unless exists $self->filters->{$fname};
1418
        
1419
            $self->{default_in_filter} = $self->filters->{$fname};
1420
        }
1421
        
1422
        return $self;
1423
    }
1424
    
many changed
Yuki Kimoto authored on 2011-01-23
1425
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1426
}
1427

            
cleanup
Yuki Kimoto authored on 2011-01-25
1428
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1429
sub register_tag_processor {
1430
    return shift->query_builder->register_tag_processor(@_);
1431
}
1432

            
cleanup
Yuki Kimoto authored on 2011-03-08
1433
# DEPRECATED!
1434
sub _push_relation {
1435
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1436
    
1437
    if (keys %{$relation || {}}) {
1438
        push @$sql, $need_where ? 'where' : 'and';
1439
        foreach my $rcolumn (keys %$relation) {
1440
            my $table1 = (split (/\./, $rcolumn))[0];
1441
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1442
            push @$tables, ($table1, $table2);
1443
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1444
        }
1445
    }
1446
    pop @$sql if $sql->[-1] eq 'and';    
1447
}
1448

            
1449
# DEPRECATED!
1450
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1451
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1452
    
1453
    if (keys %{$relation || {}}) {
1454
        foreach my $rcolumn (keys %$relation) {
1455
            my $table1 = (split (/\./, $rcolumn))[0];
1456
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1457
            my $table1_exists;
1458
            my $table2_exists;
1459
            foreach my $table (@$tables) {
1460
                $table1_exists = 1 if $table eq $table1;
1461
                $table2_exists = 1 if $table eq $table2;
1462
            }
1463
            unshift @$tables, $table1 unless $table1_exists;
1464
            unshift @$tables, $table2 unless $table2_exists;
1465
        }
1466
    }
1467
}
1468

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1471
=head1 NAME
1472

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

            
1475
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1476

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1477
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1478
    
1479
    # Connect
1480
    my $dbi = DBIx::Custom->connect(
1481
        data_source => "dbi:mysql:database=dbname",
1482
        user => 'ken',
1483
        password => '!LFKD%$&',
1484
        dbi_option => {mysql_enable_utf8 => 1}
1485
    );
cleanup
yuki-kimoto authored on 2010-08-05
1486

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1487
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1488
    $dbi->insert(
1489
        table  => 'book',
1490
        param  => {title => 'Perl', author => 'Ken'}
1491
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1492
    
1493
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1494
    $dbi->update(
1495
        table  => 'book', 
1496
        param  => {title => 'Perl', author => 'Ken'}, 
1497
        where  => {id => 5},
1498
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1499
    
1500
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1501
    $dbi->delete(
1502
        table  => 'book',
1503
        where  => {author => 'Ken'},
1504
    );
cleanup
yuki-kimoto authored on 2010-08-05
1505

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1512
    # Select, more complex
1513
    my $result = $dbi->select(
1514
        table  => 'book',
1515
        column => [
1516
            'book.author as book__author',
1517
            'company.name as company__name'
1518
        ],
1519
        where  => {'book.author' => 'Ken'},
1520
        join => ['left outer join company on book.company_id = company.id'],
1521
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1522
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1523
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1524
    # Fetch
1525
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1526
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1527
    }
1528
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1529
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1530
    while (my $row = $result->fetch_hash) {
1531
        
1532
    }
1533
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1534
    # Execute SQL with parameter.
1535
    $dbi->execute(
1536
        "select id from book where {= author} and {like title}",
1537
        param  => {author => 'ken', title => '%Perl%'}
1538
    );
1539
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1540
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1541

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

            
1544
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1545

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1550
There are many basic methods to execute various queries.
1551
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1552
C<delete_all()>, C<select()>,
1553
C<insert_at()>, C<update_at()>, 
1554
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1555

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1556
=item *
1557

            
1558
Filter when data is send or receive.
1559

            
1560
=item *
1561

            
1562
Data filtering system
1563

            
1564
=item *
1565

            
1566
Model support.
1567

            
1568
=item *
1569

            
1570
Generate where clause dinamically.
1571

            
1572
=item *
1573

            
1574
Generate join clause dinamically.
1575

            
1576
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1577

            
1578
=head1 GUIDE
1579

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

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

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

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

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

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

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

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

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

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

            
1603
=head2 C<default_dbi_option>
1604

            
1605
    my $default_dbi_option = $dbi->default_dbi_option;
1606
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1607

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1611
    {
1612
        RaiseError => 1,
1613
        PrintError => 0,
1614
        AutoCommit => 1,
1615
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1616

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

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

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

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

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

            
1629
    my $models = $dbi->models;
1630
    $dbi       = $dbi->models(\%models);
1631

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1634
=head2 C<password>
1635

            
1636
    my $password = $dbi->password;
1637
    $dbi         = $dbi->password('lkj&le`@s');
1638

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

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

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

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

            
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1648
=head2 C<reserved_word_quote> EXPERIMENTAL
1649

            
1650
     my reserved_word_quote = $dbi->reserved_word_quote;
1651
     $dbi                   = $dbi->reserved_word_quote('"');
1652

            
1653
Quote for reserved word, default to empty string.
1654

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

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

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1662
=head2 C<safety_character>
update pod
Yuki Kimoto authored on 2011-01-27
1663

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1672
    my $user = $dbi->user;
1673
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1674

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1685
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1686
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1687
        'issue_date' => {
1688
            out => 'tp_to_date',
1689
            in  => 'date_to_tp',
1690
            end => 'tp_to_displaydate'
1691
        },
1692
        'write_date' => {
1693
            out => 'tp_to_date',
1694
            in  => 'date_to_tp',
1695
            end => 'tp_to_displaydate'
1696
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1697
    );
1698

            
update pod
Yuki Kimoto authored on 2011-03-13
1699
Apply filter to columns.
1700
C<out> filter is executed before data is send to database.
1701
C<in> filter is executed after a row is fetch.
1702
C<end> filter is execute after C<in> filter is executed.
1703

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1706
       PETTERN         EXAMPLE
1707
    1. Column        : author
1708
    2. Table.Column  : book.author
1709
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1710

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

            
1714
You can set multiple filters at once.
1715

            
1716
    $dbi->apply_filter(
1717
        'book',
1718
        [qw/issue_date write_date/] => {
1719
            out => 'tp_to_date',
1720
            in  => 'date_to_tp',
1721
            end => 'tp_to_displaydate'
1722
        }
1723
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1724

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1727
    my $dbi = DBIx::Custom->connect(
1728
        data_source => "dbi:mysql:database=dbname",
1729
        user => 'ken',
1730
        password => '!LFKD%$&',
1731
        dbi_option => {mysql_enable_utf8 => 1}
1732
    );
1733

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

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1740
=head2 create_model
1741

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1742
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1743
        table => 'book',
1744
        primary_key => 'id',
1745
        join => [
1746
            'inner join company on book.comparny_id = company.id'
1747
        ],
1748
        filter => [
1749
            publish_date => {
1750
                out => 'tp_to_date',
1751
                in => 'date_to_tp',
1752
                end => 'tp_to_displaydate'
1753
            }
1754
        ]
1755
    );
1756

            
1757
Create L<DBIx::Custom::Model> object and initialize model.
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1758
the module is also used from model() method.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1759

            
1760
   $dbi->model('book')->select(...);
1761

            
cleanup
yuki-kimoto authored on 2010-10-17
1762
=head2 C<create_query>
1763
    
1764
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1765
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1766
    );
update document
yuki-kimoto authored on 2009-11-19
1767

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

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

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

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

            
1778
    my $dbh = $dbi->dbh;
1779
    $dbi    = $dbi->dbh($dbh);
1780

            
1781
Get and set database handle of L<DBI>.
1782

            
update pod
Yuki Kimoto authored on 2011-03-13
1783
If process is spawn by forking, new connection is created automatically.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1784

            
1785
=head2 C<each_column>
1786

            
1787
    $dbi->each_column(
1788
        sub {
1789
            my ($dbi, $table, $column, $column_info) = @_;
1790
            
1791
            my $type = $column_info->{TYPE_NAME};
1792
            
1793
            if ($type eq 'DATE') {
1794
                # ...
1795
            }
1796
        }
1797
    );
1798

            
1799
Iterate all column informations of all table from database.
1800
Argument is callback when one column is found.
1801
Callback receive four arguments, dbi object, table name,
1802
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1803

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1806
    my $result = $dbi->execute(
1807
        "select * from book where {= title} and {like author}",
1808
        param => {title => 'Perl', author => '%Ken%'}
1809
    );
1810

            
1811
Execute SQL, containing tags.
1812
Return value is L<DBIx::Custom::Result> in select statement, or
1813
the count of affected rows in insert, update, delete statement.
1814

            
1815
Tag is turned into the statement containing place holder
1816
before SQL is executed.
1817

            
1818
    select * from where title = ? and author like ?;
1819

            
1820
See also L<Tags/Tags>.
1821

            
1822
The following opitons are currently available.
1823

            
1824
=over 4
1825

            
1826
=item C<filter>
1827

            
1828
Filter, executed before data is send to database. This is array reference.
1829
Filter value is code reference or
1830
filter name registerd by C<register_filter()>.
1831

            
1832
    # Basic
1833
    $dbi->execute(
1834
        $sql,
1835
        filter => [
1836
            title  => sub { uc $_[0] }
1837
            author => sub { uc $_[0] }
1838
        ]
1839
    );
1840
    
1841
    # At once
1842
    $dbi->execute(
1843
        $sql,
1844
        filter => [
1845
            [qw/title author/]  => sub { uc $_[0] }
1846
        ]
1847
    );
1848
    
1849
    # Filter name
1850
    $dbi->execute(
1851
        $sql,
1852
        filter => [
1853
            title  => 'upper_case',
1854
            author => 'upper_case'
1855
        ]
1856
    );
1857

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

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

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

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

            
1866
Delete statement.
1867

            
1868
The following opitons are currently available.
1869

            
update pod
Yuki Kimoto authored on 2011-03-13
1870
=over 4
1871

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

            
1874
Table name.
1875

            
1876
    $dbi->delete(table => 'book');
1877

            
1878
=item C<where>
1879

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1880
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1881
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1882
    
1883
    # Hash reference
1884
    $dbi->delete(where => {title => 'Perl'});
1885
    
1886
    # DBIx::Custom::Where object
1887
    my $where = $dbi->where(
1888
        clause => ['and', '{= author}', '{like title}'],
1889
        param  => {author => 'Ken', title => '%Perl%'}
1890
    );
1891
    $dbi->delete(where => $where);
1892

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1893
    # Array refrendce (where clause and parameter)
1894
    $dbi->delete(where =>
1895
        [
1896
            ['and', '{= author}', '{like title}'],
1897
            {author => 'Ken', title => '%Perl%'}
1898
        ]
1899
    );
1900
    
update pod
Yuki Kimoto authored on 2011-03-13
1901
=item C<append>
1902

            
1903
Append statement to last of SQL. This is string.
1904

            
1905
    $dbi->delete(append => 'order by title');
1906

            
1907
=item C<filter>
1908

            
1909
Filter, executed before data is send to database. This is array reference.
1910
Filter value is code reference or
1911
filter name registerd by C<register_filter()>.
1912

            
1913
    # Basic
1914
    $dbi->delete(
1915
        filter => [
1916
            title  => sub { uc $_[0] }
1917
            author => sub { uc $_[0] }
1918
        ]
1919
    );
1920
    
1921
    # At once
1922
    $dbi->delete(
1923
        filter => [
1924
            [qw/title author/]  => sub { uc $_[0] }
1925
        ]
1926
    );
1927
    
1928
    # Filter name
1929
    $dbi->delete(
1930
        filter => [
1931
            title  => 'upper_case',
1932
            author => 'upper_case'
1933
        ]
1934
    );
1935

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

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

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

            
1942
Create column clause. The follwoing column clause is created.
1943

            
1944
    book.author as book__author,
1945
    book.title as book__title
1946

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1947
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
1948

            
1949
Get L<DBIx::Custom::Query> object instead of executing SQL.
1950
This is true or false value.
1951

            
1952
    my $query = $dbi->delete(query => 1);
1953

            
1954
You can check SQL.
1955

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1958
=back
1959

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

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

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1967
=head2 C<delete_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1968

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

            
1971
    $dbi->delete_at(
1972
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1973
        primary_key => 'id',
1974
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1975
    );
1976

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1981
=over 4
1982

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1985
Primary key. This is constant value or array reference.
1986
    
1987
    # Constant value
1988
    $dbi->delete(primary_key => 'id');
1989

            
1990
    # Array reference
1991
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1992

            
1993
This is used to create where clause.
1994

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

            
1997
Where clause, created from primary key information.
1998
This is constant value or array reference.
1999

            
2000
    # Constant value
2001
    $dbi->delete(where => 5);
2002

            
2003
    # Array reference
2004
    $dbi->delete(where => [3, 5]);
2005

            
2006
In first examle, the following SQL is created.
2007

            
2008
    delete from book where id = ?;
2009

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2012
=back
2013

            
cleanup
yuki-kimoto authored on 2010-10-17
2014
=head2 C<insert>
2015

            
update pod
Yuki Kimoto authored on 2011-03-13
2016
    $dbi->insert(
2017
        table  => 'book', 
2018
        param  => {title => 'Perl', author => 'Ken'}
2019
    );
2020

            
2021
Insert statement.
2022

            
2023
The following opitons are currently available.
2024

            
update pod
Yuki Kimoto authored on 2011-03-13
2025
=over 4
2026

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

            
2029
Table name.
2030

            
2031
    $dbi->insert(table => 'book');
2032

            
2033
=item C<param>
2034

            
2035
Insert data. This is hash reference.
2036

            
2037
    $dbi->insert(param => {title => 'Perl'});
2038

            
2039
=item C<append>
2040

            
2041
Append statement to last of SQL. This is string.
2042

            
2043
    $dbi->insert(append => 'order by title');
2044

            
2045
=item C<filter>
2046

            
2047
Filter, executed before data is send to database. This is array reference.
2048
Filter value is code reference or
2049
filter name registerd by C<register_filter()>.
2050

            
2051
    # Basic
2052
    $dbi->insert(
2053
        filter => [
2054
            title  => sub { uc $_[0] }
2055
            author => sub { uc $_[0] }
2056
        ]
2057
    );
2058
    
2059
    # At once
2060
    $dbi->insert(
2061
        filter => [
2062
            [qw/title author/]  => sub { uc $_[0] }
2063
        ]
2064
    );
2065
    
2066
    # Filter name
2067
    $dbi->insert(
2068
        filter => [
2069
            title  => 'upper_case',
2070
            author => 'upper_case'
2071
        ]
2072
    );
2073

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2076
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
2077

            
2078
Get L<DBIx::Custom::Query> object instead of executing SQL.
2079
This is true or false value.
2080

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2087
=back
2088

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2089
=head2 C<insert_at()>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2090

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

            
2093
    $dbi->insert_at(
2094
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2095
        primary_key => 'id',
2096
        where => '5',
2097
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2098
    );
2099

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2104
=over 4
2105

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

            
2108
Primary key. This is constant value or array reference.
2109
    
2110
    # Constant value
2111
    $dbi->insert(primary_key => 'id');
2112

            
2113
    # Array reference
2114
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2115

            
2116
This is used to create parts of insert data.
2117

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

            
2120
Parts of Insert data, create from primary key information.
2121
This is constant value or array reference.
2122

            
2123
    # Constant value
2124
    $dbi->insert(where => 5);
2125

            
2126
    # Array reference
2127
    $dbi->insert(where => [3, 5]);
2128

            
2129
In first examle, the following SQL is created.
2130

            
2131
    insert into book (id, title) values (?, ?);
2132

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2135
=back
2136

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2137
=head2 C<insert_param>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2138

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

            
2141
Create insert parameter tag.
2142

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2152
    lib / MyModel.pm
2153
        / MyModel / book.pm
2154
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2155

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

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

            
2160
    package MyModel;
2161
    
2162
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2163
    
2164
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2165

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2170
    package MyModel::book;
2171
    
2172
    use base 'MyModel';
2173
    
2174
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2175

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2178
    package MyModel::company;
2179
    
2180
    use base 'MyModel';
2181
    
2182
    1;
2183
    
2184
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2185

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

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

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

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

            
2195
    $dbi->method(
2196
        update_or_insert => sub {
2197
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2198
            
2199
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2200
        },
2201
        find_or_create   => sub {
2202
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2203
            
2204
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2205
        }
2206
    );
2207

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

            
2210
    $dbi->update_or_insert;
2211
    $dbi->find_or_create;
2212

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

            
2215
    $dbi->model('book')->method(
2216
        insert => sub { ... },
2217
        update => sub { ... }
2218
    );
2219
    
2220
    my $model = $dbi->model('book');
2221

            
2222
Set and get a L<DBIx::Custom::Model> object,
2223

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

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

            
2228
Create column clause for myself. The follwoing column clause is created.
2229

            
2230
    book.author as author,
2231
    book.title as title
2232

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2235
    my $dbi = DBIx::Custom->new(
2236
        data_source => "dbi:mysql:database=dbname",
2237
        user => 'ken',
2238
        password => '!LFKD%$&',
2239
        dbi_option => {mysql_enable_utf8 => 1}
2240
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2241

            
2242
Create a new L<DBIx::Custom> object.
2243

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2244
=head2 C<not_exists>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2245

            
2246
    my $not_exists = $dbi->not_exists;
2247

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2251
=head2 C<register_filter>
2252

            
update pod
Yuki Kimoto authored on 2011-03-13
2253
    $dbi->register_filter(
2254
        # Time::Piece object to database DATE format
2255
        tp_to_date => sub {
2256
            my $tp = shift;
2257
            return $tp->strftime('%Y-%m-%d');
2258
        },
2259
        # database DATE format to Time::Piece object
2260
        date_to_tp => sub {
2261
           my $date = shift;
2262
           return Time::Piece->strptime($date, '%Y-%m-%d');
2263
        }
2264
    );
cleanup
yuki-kimoto authored on 2010-10-17
2265
    
update pod
Yuki Kimoto authored on 2011-03-13
2266
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2267

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2270
    $dbi->register_tag(
2271
        update => sub {
2272
            my @columns = @_;
2273
            
2274
            # Update parameters
2275
            my $s = 'set ';
2276
            $s .= "$_ = ?, " for @columns;
2277
            $s =~ s/, $//;
2278
            
2279
            return [$s, \@columns];
2280
        }
2281
    );
cleanup
yuki-kimoto authored on 2010-10-17
2282

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2306
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2307
        table  => 'book',
2308
        column => ['author', 'title'],
2309
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2310
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2311
    
update pod
Yuki Kimoto authored on 2011-03-12
2312
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2313

            
2314
The following opitons are currently available.
2315

            
2316
=over 4
2317

            
2318
=item C<table>
2319

            
2320
Table name.
2321

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

            
2324
=item C<column>
2325

            
2326
Column clause. This is array reference or constant value.
2327

            
2328
    # Hash refernce
2329
    $dbi->select(column => ['author', 'title']);
2330
    
2331
    # Constant value
2332
    $dbi->select(column => 'author');
2333

            
2334
Default is '*' unless C<column> is specified.
2335

            
2336
    # Default
2337
    $dbi->select(column => '*');
2338

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

            
2341
=over 4
2342

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

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

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

            
2349
If main table is C<book> and joined table is C<company>,
2350
This create the following column clause.
2351

            
2352
    book.author as author
2353
    book.company_id as company_id
2354
    company.id as company__id
2355
    company.name as company__name
2356

            
2357
Columns of main table is consist of only column name,
2358
Columns of joined table is consist of table and column name joined C<__>.
2359

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

            
2363
    # Generally do the following way before using all_column option
2364
    $dbi->include_model('MyModel')->setup_model;
2365

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

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

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

            
2372
=item prepend EXPERIMENTAL
2373

            
2374
You can add before created statement
2375

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

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

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2382
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2383
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2384
    
2385
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2386
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2387
    
update pod
Yuki Kimoto authored on 2011-03-12
2388
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2389
    my $where = $dbi->where(
2390
        clause => ['and', '{= author}', '{like title}'],
2391
        param  => {author => 'Ken', title => '%Perl%'}
2392
    );
update pod
Yuki Kimoto authored on 2011-03-12
2393
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2394

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2395
    # Array refrendce (where clause and parameter)
2396
    $dbi->select(where =>
2397
        [
2398
            ['and', '{= author}', '{like title}'],
2399
            {author => 'Ken', title => '%Perl%'}
2400
        ]
2401
    );
2402
    
update pod
Yuki Kimoto authored on 2011-03-13
2403
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2404

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

            
2407
    $dbi->select(join =>
2408
        [
2409
            'left outer join company on book.company_id = company_id',
2410
            'left outer join location on company.location_id = location.id'
2411
        ]
2412
    );
2413

            
2414
If column cluase or where clause contain table name like "company.name",
2415
needed join clause is used automatically.
2416

            
2417
    $dbi->select(
2418
        table => 'book',
2419
        column => ['company.location_id as company__location_id'],
2420
        where => {'company.name' => 'Orange'},
2421
        join => [
2422
            'left outer join company on book.company_id = company.id',
2423
            'left outer join location on company.location_id = location.id'
2424
        ]
2425
    );
2426

            
2427
In above select, the following SQL is created.
2428

            
2429
    select company.location_id as company__location_id
2430
    from book
2431
      left outer join company on book.company_id = company.id
2432
    where company.name = Orange
2433

            
2434
=item C<append>
2435

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

            
2438
    $dbi->select(append => 'order by title');
2439

            
2440
=item C<filter>
2441

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

            
2446
    # Basic
2447
    $dbi->select(
2448
        filter => [
2449
            title  => sub { uc $_[0] }
2450
            author => sub { uc $_[0] }
2451
        ]
2452
    );
2453
    
2454
    # At once
2455
    $dbi->select(
2456
        filter => [
2457
            [qw/title author/]  => sub { uc $_[0] }
2458
        ]
2459
    );
2460
    
2461
    # Filter name
2462
    $dbi->select(
2463
        filter => [
2464
            title  => 'upper_case',
2465
            author => 'upper_case'
2466
        ]
2467
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2468

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2471
=item C<query>
cleanup
yuki-kimoto authored on 2010-08-09
2472

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

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

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

            
2480
    my $sql = $query->sql;
2481

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

            
2484
Specify database data type.
2485

            
2486
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2487
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2488

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

            
2491
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2492

            
update pod
Yuki Kimoto authored on 2011-03-12
2493
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2494

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2495
=head2 C<select_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2496

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

            
2499
    $dbi->select_at(
2500
        table => 'book',
2501
        primary_key => 'id',
2502
        where => '5'
2503
    );
2504

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2509
=over 4
2510

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2513
Primary key. This is constant value or array reference.
2514
    
2515
    # Constant value
2516
    $dbi->select(primary_key => 'id');
2517

            
2518
    # Array reference
2519
    $dbi->select(primary_key => ['id1', 'id2' ]);
2520

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

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

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

            
2528
    # Constant value
2529
    $dbi->select(where => 5);
2530

            
2531
    # Array reference
2532
    $dbi->select(where => [3, 5]);
2533

            
2534
In first examle, the following SQL is created.
2535

            
2536
    select * from book where id = ?
2537

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2540
=back
2541

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2544
    $dbi->update(
2545
        table  => 'book',
2546
        param  => {title => 'Perl'},
2547
        where  => {id => 4}
2548
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2549

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2554
=over 4
2555

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2558
Table name.
2559

            
2560
    $dbi->update(table => 'book');
2561

            
2562
=item C<param>
2563

            
2564
Update data. This is hash reference.
2565

            
2566
    $dbi->update(param => {title => 'Perl'});
2567

            
2568
=item C<where>
2569

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2570
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2571
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2572
    
2573
    # Hash reference
2574
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2575
    
2576
    # DBIx::Custom::Where object
2577
    my $where = $dbi->where(
2578
        clause => ['and', '{= author}', '{like title}'],
2579
        param  => {author => 'Ken', title => '%Perl%'}
2580
    );
2581
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2582
    
2583
    # Array refrendce (where clause and parameter)
2584
    $dbi->update(where =>
2585
        [
2586
            ['and', '{= author}', '{like title}'],
2587
            {author => 'Ken', title => '%Perl%'}
2588
        ]
2589
    );
update pod
Yuki Kimoto authored on 2011-03-13
2590

            
2591
=item C<append>
2592

            
2593
Append statement to last of SQL. This is string.
2594

            
2595
    $dbi->update(append => 'order by title');
2596

            
2597
=item C<filter>
2598

            
2599
Filter, executed before data is send to database. This is array reference.
2600
Filter value is code reference or
2601
filter name registerd by C<register_filter()>.
2602

            
2603
    # Basic
2604
    $dbi->update(
2605
        filter => [
2606
            title  => sub { uc $_[0] }
2607
            author => sub { uc $_[0] }
2608
        ]
2609
    );
2610
    
2611
    # At once
2612
    $dbi->update(
2613
        filter => [
2614
            [qw/title author/]  => sub { uc $_[0] }
2615
        ]
2616
    );
2617
    
2618
    # Filter name
2619
    $dbi->update(
2620
        filter => [
2621
            title  => 'upper_case',
2622
            author => 'upper_case'
2623
        ]
2624
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2625

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2628
=item C<query>
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2629

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

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

            
2635
You can check SQL.
2636

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2639
=back
2640

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

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

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2648
=head2 C<update_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2649

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

            
2652
    $dbi->update_at(
2653
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2654
        primary_key => 'id',
2655
        where => '5',
2656
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2657
    );
2658

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2663
=over 4
2664

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

            
2667
Primary key. This is constant value or array reference.
2668
    
2669
    # Constant value
2670
    $dbi->update(primary_key => 'id');
2671

            
2672
    # Array reference
2673
    $dbi->update(primary_key => ['id1', 'id2' ]);
2674

            
2675
This is used to create where clause.
2676

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

            
2679
Where clause, created from primary key information.
2680
This is constant value or array reference.
2681

            
2682
    # Constant value
2683
    $dbi->update(where => 5);
2684

            
2685
    # Array reference
2686
    $dbi->update(where => [3, 5]);
2687

            
2688
In first examle, the following SQL is created.
2689

            
2690
    update book set title = ? where id = ?
2691

            
2692
Place holders are set to 'Perl' and 5.
2693

            
update pod
Yuki Kimoto authored on 2011-03-13
2694
=back
2695

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2696
=head2 C<update_param>
update pod
Yuki Kimoto authored on 2011-03-13
2697

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

            
2700
Create update parameter tag.
2701

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2704
=head2 C<where>
fix tests
Yuki Kimoto authored on 2011-01-18
2705

            
cleanup
Yuki Kimoto authored on 2011-03-09
2706
    my $where = $dbi->where(
2707
        clause => ['and', '{= title}', '{= author}'],
2708
        param => {title => 'Perl', author => 'Ken'}
2709
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2710

            
2711
Create a new L<DBIx::Custom::Where> object.
2712

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2720
=head1 Tags
2721

            
2722
The following tags is available.
2723

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2724
=head2 C<table>
add table tag
Yuki Kimoto authored on 2011-02-09
2725

            
2726
Table tag
2727

            
2728
    {table TABLE}    ->    TABLE
2729

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2732
=head2 C<?>
2733

            
2734
Placeholder tag.
2735

            
2736
    {? NAME}    ->   ?
2737

            
2738
=head2 C<=>
2739

            
2740
Equal tag.
2741

            
2742
    {= NAME}    ->   NAME = ?
2743

            
2744
=head2 C<E<lt>E<gt>>
2745

            
2746
Not equal tag.
2747

            
2748
    {<> NAME}   ->   NAME <> ?
2749

            
2750
=head2 C<E<lt>>
2751

            
2752
Lower than tag
2753

            
2754
    {< NAME}    ->   NAME < ?
2755

            
2756
=head2 C<E<gt>>
2757

            
2758
Greater than tag
2759

            
2760
    {> NAME}    ->   NAME > ?
2761

            
2762
=head2 C<E<gt>=>
2763

            
2764
Greater than or equal tag
2765

            
2766
    {>= NAME}   ->   NAME >= ?
2767

            
2768
=head2 C<E<lt>=>
2769

            
2770
Lower than or equal tag
2771

            
2772
    {<= NAME}   ->   NAME <= ?
2773

            
2774
=head2 C<like>
2775

            
2776
Like tag
2777

            
2778
    {like NAME}   ->   NAME like ?
2779

            
2780
=head2 C<in>
2781

            
2782
In tag.
2783

            
2784
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2785

            
2786
=head2 C<insert_param>
2787

            
2788
Insert parameter tag.
2789

            
2790
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2791

            
2792
=head2 C<update_param>
2793

            
2794
Updata parameter tag.
2795

            
2796
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2797

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

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

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

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

            
2807
C<< <kimoto.yuki at gmail.com> >>
2808

            
2809
L<http://github.com/yuki-kimoto/DBIx-Custom>
2810

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2811
=head1 AUTHOR
2812

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

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

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

            
2819
This program is free software; you can redistribute it and/or modify it
2820
under the same terms as Perl itself.
2821

            
2822
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2823

            
2824