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

            
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
3
our $VERSION = '0.1670';
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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
654
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
655
    my ($self, $param) = @_;
656
    
update pod
Yuki Kimoto authored on 2011-03-13
657
    # Insert parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
658
    my @names;
659
    my @placeholders;
660
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
661
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
662
    my $q = $self->reserved_word_quote;
663
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
664
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
665
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
666
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
667
        
668
        my $c = "$q$column$q";
669
        $c =~ s/\./$q.$q/;
670
        
671
        push @names, $c;
672
        push @placeholders, "{? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
673
    }
674
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
675
    return '(' . join(', ', @names) . ') ' . 'values' .
676
           ' (' . join(', ', @placeholders) . ')';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
677
}
678

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
742
sub merge_param {
743
    my ($self, @params) = @_;
744
    
745
    my $param = {};
746
    
747
    foreach my $p (@params) {
748
        foreach my $column (keys %$p) {
749
            if (exists $param->{$column}) {
750
                $param->{$column} = [$param->{$column}]
751
                  unless ref $param->{$column} eq 'ARRAY';
752
                push @{$param->{$column}}, $p->{$column};
753
            }
754
            else {
755
                $param->{$column} = $p->{$column};
756
            }
757
        }
758
    }
759
    
760
    return $param;
761
}
762

            
cleanup
Yuki Kimoto authored on 2011-03-21
763
sub method {
764
    my $self = shift;
765
    
766
    # Merge
767
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
768
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
769
    
770
    return $self;
771
}
772

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
773
sub model {
774
    my ($self, $name, $model) = @_;
775
    
776
    # Set
777
    if ($model) {
778
        $self->models->{$name} = $model;
779
        return $self;
780
    }
781
    
782
    # Check model existance
783
    croak qq{Model "$name" is not included}
784
      unless $self->models->{$name};
785
    
786
    # Get
787
    return $self->models->{$name};
788
}
789

            
cleanup
Yuki Kimoto authored on 2011-03-21
790
sub mycolumn {
791
    my ($self, $table, $columns) = @_;
792
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
793
    my $q = $self->reserved_word_quote;
794
    
cleanup
Yuki Kimoto authored on 2011-03-21
795
    $columns ||= [];
796
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
797
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
798
    
799
    return join (', ', @column);
800
}
801

            
added dbi_options attribute
kimoto authored on 2010-12-20
802
sub new {
803
    my $self = shift->SUPER::new(@_);
804
    
805
    # Check attribute names
806
    my @attrs = keys %$self;
807
    foreach my $attr (@attrs) {
808
        croak qq{"$attr" is invalid attribute name}
809
          unless $self->can($attr);
810
    }
cleanup
Yuki Kimoto authored on 2011-01-25
811

            
812
    $self->register_tag(
813
        '?'     => \&DBIx::Custom::Tag::placeholder,
814
        '='     => \&DBIx::Custom::Tag::equal,
815
        '<>'    => \&DBIx::Custom::Tag::not_equal,
816
        '>'     => \&DBIx::Custom::Tag::greater_than,
817
        '<'     => \&DBIx::Custom::Tag::lower_than,
818
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
819
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
820
        'like'  => \&DBIx::Custom::Tag::like,
821
        'in'    => \&DBIx::Custom::Tag::in,
822
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
823
        'update_param' => \&DBIx::Custom::Tag::update_param
824
    );
added dbi_options attribute
kimoto authored on 2010-12-20
825
    
826
    return $self;
827
}
828

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

            
cleanup
yuki-kimoto authored on 2010-10-17
831
sub register_filter {
832
    my $invocant = shift;
833
    
834
    # Register filter
835
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
836
    $invocant->filters({%{$invocant->filters}, %$filters});
837
    
838
    return $invocant;
839
}
packaging one directory
yuki-kimoto authored on 2009-11-16
840

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

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

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

            
849
    # Quote for reserved word
850
    my $q = $self->reserved_word_quote;
packaging one directory
yuki-kimoto authored on 2009-11-16
851
    
cleanup
Yuki Kimoto authored on 2011-03-09
852
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
853
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
854
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
855
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
856
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
857
    
refactoring select
yuki-kimoto authored on 2010-04-28
858
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
859
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
860
    my $tables = ref $table eq 'ARRAY' ? $table
861
               : defined $table ? [$table]
862
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
863
    my $columns   = delete $args{column};
864
    my $where     = delete $args{where} || {};
865
    my $append    = delete $args{append};
866
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
867
    croak qq{"join" must be array reference}
868
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
869
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
870
    my $param = delete $args{param} || {};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
871
    
cleanup
Yuki Kimoto authored on 2011-03-09
872
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
873
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
874
    
cleanup
Yuki Kimoto authored on 2011-01-27
875
    # SQL stack
876
    my @sql;
877
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
878
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
879
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
880
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
881
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
882
        foreach my $column (@$columns) {
883
            unshift @$tables, @{$self->_tables($column)};
884
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
885
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
886
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
887
    }
888
    
889
    # "*" is default
890
    else { push @sql, '*' }
891
    
892
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
893
    push @sql, 'from';
894
    if ($relation) {
895
        my $found = {};
896
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
897
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
898
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
899
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
900
    }
cleanup
Yuki Kimoto authored on 2011-03-30
901
    else {
902
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
903
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
904
    }
905
    pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
906
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
907
    # Main table
908
    croak "Not found table name" unless $tables->[-1];
909
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
910
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
911
    my $w = $self->_where($where);
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
912
    $param = keys %$param ? $self->merge_param($param, $w->param)
913
                         : $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
914
    
915
    # String where
916
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
917
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
918
    # Add table names in where clause
919
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
920
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
921
    # Push join
922
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
923
    
cleanup
Yuki Kimoto authored on 2011-03-09
924
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
925
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
926
    
cleanup
Yuki Kimoto authored on 2011-03-08
927
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
928
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
929
    
cleanup
Yuki Kimoto authored on 2011-01-27
930
    # Append statement
931
    push @sql, $append if $append;
932
    
933
    # SQL
934
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
935
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
936
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
937
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
938
    return $query if $args{query};
939
    
packaging one directory
yuki-kimoto authored on 2009-11-16
940
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
941
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
942
        $query,
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
943
        param  => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
944
        table => $tables,
945
        %args
946
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
947
    
948
    return $result;
949
}
950

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

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

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

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

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

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

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

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

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

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1139
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1140
    my ($self, $param, $opt) = @_;
1141
    
1142
    # Insert parameter tag
1143
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1144
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1145
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1146
    my $q = $self->reserved_word_quote;
1147
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1148
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1149
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1150
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1151
        
1152
        my $c = "$q$column$q";
1153
        $c =~ s/\./$q.$q/;
1154
        
1155
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1156
    }
1157
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1158
    my $clause;
1159
    $clause .= 'set ' unless $opt->{no_set};
1160
    $clause .= join(', ', @params);
1161
    
1162
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1163
}
1164

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1427
# DEPRECATED!
1428
sub insert_param {
1429
    warn "insert_param is renamed to insert_param_tag."
1430
       . " insert_param is DEPRECATED!";
1431
    return shift->insert_param_tag(@_);
1432
}
1433

            
cleanup
Yuki Kimoto authored on 2011-01-25
1434
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1435
sub register_tag_processor {
1436
    return shift->query_builder->register_tag_processor(@_);
1437
}
1438

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1439
# DEPRECATED!
1440
sub update_param {
1441
    warn "update_param is renamed to update_param_tag."
1442
       . " update_param is DEPRECATED!";
1443
    return shift->update_param_tag(@_);
1444
}
cleanup
Yuki Kimoto authored on 2011-03-08
1445
# DEPRECATED!
1446
sub _push_relation {
1447
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1448
    
1449
    if (keys %{$relation || {}}) {
1450
        push @$sql, $need_where ? 'where' : 'and';
1451
        foreach my $rcolumn (keys %$relation) {
1452
            my $table1 = (split (/\./, $rcolumn))[0];
1453
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1454
            push @$tables, ($table1, $table2);
1455
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1456
        }
1457
    }
1458
    pop @$sql if $sql->[-1] eq 'and';    
1459
}
1460

            
1461
# DEPRECATED!
1462
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1463
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1464
    
1465
    if (keys %{$relation || {}}) {
1466
        foreach my $rcolumn (keys %$relation) {
1467
            my $table1 = (split (/\./, $rcolumn))[0];
1468
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1469
            my $table1_exists;
1470
            my $table2_exists;
1471
            foreach my $table (@$tables) {
1472
                $table1_exists = 1 if $table eq $table1;
1473
                $table2_exists = 1 if $table eq $table2;
1474
            }
1475
            unshift @$tables, $table1 unless $table1_exists;
1476
            unshift @$tables, $table2 unless $table2_exists;
1477
        }
1478
    }
1479
}
1480

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1483
=head1 NAME
1484

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

            
1487
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1488

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1489
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1490
    
1491
    # Connect
1492
    my $dbi = DBIx::Custom->connect(
1493
        data_source => "dbi:mysql:database=dbname",
1494
        user => 'ken',
1495
        password => '!LFKD%$&',
1496
        dbi_option => {mysql_enable_utf8 => 1}
1497
    );
cleanup
yuki-kimoto authored on 2010-08-05
1498

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1499
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1500
    $dbi->insert(
1501
        table  => 'book',
1502
        param  => {title => 'Perl', author => 'Ken'}
1503
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1504
    
1505
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1506
    $dbi->update(
1507
        table  => 'book', 
1508
        param  => {title => 'Perl', author => 'Ken'}, 
1509
        where  => {id => 5},
1510
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1511
    
1512
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1513
    $dbi->delete(
1514
        table  => 'book',
1515
        where  => {author => 'Ken'},
1516
    );
cleanup
yuki-kimoto authored on 2010-08-05
1517

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

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

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

            
1556
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1557

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1562
There are many basic methods to execute various queries.
1563
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1564
C<delete_all()>, C<select()>,
1565
C<insert_at()>, C<update_at()>, 
1566
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1567

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1568
=item *
1569

            
1570
Filter when data is send or receive.
1571

            
1572
=item *
1573

            
1574
Data filtering system
1575

            
1576
=item *
1577

            
1578
Model support.
1579

            
1580
=item *
1581

            
1582
Generate where clause dinamically.
1583

            
1584
=item *
1585

            
1586
Generate join clause dinamically.
1587

            
1588
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1589

            
1590
=head1 GUIDE
1591

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

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

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

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

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

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

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

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

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

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

            
1615
=head2 C<default_dbi_option>
1616

            
1617
    my $default_dbi_option = $dbi->default_dbi_option;
1618
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1619

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1623
    {
1624
        RaiseError => 1,
1625
        PrintError => 0,
1626
        AutoCommit => 1,
1627
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1628

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

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

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

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

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

            
1641
    my $models = $dbi->models;
1642
    $dbi       = $dbi->models(\%models);
1643

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1646
=head2 C<password>
1647

            
1648
    my $password = $dbi->password;
1649
    $dbi         = $dbi->password('lkj&le`@s');
1650

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

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

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

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

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

            
1662
     my reserved_word_quote = $dbi->reserved_word_quote;
1663
     $dbi                   = $dbi->reserved_word_quote('"');
1664

            
1665
Quote for reserved word, default to empty string.
1666

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1684
    my $user = $dbi->user;
1685
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1686

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1697
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1698
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1699
        'issue_date' => {
1700
            out => 'tp_to_date',
1701
            in  => 'date_to_tp',
1702
            end => 'tp_to_displaydate'
1703
        },
1704
        'write_date' => {
1705
            out => 'tp_to_date',
1706
            in  => 'date_to_tp',
1707
            end => 'tp_to_displaydate'
1708
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1709
    );
1710

            
update pod
Yuki Kimoto authored on 2011-03-13
1711
Apply filter to columns.
1712
C<out> filter is executed before data is send to database.
1713
C<in> filter is executed after a row is fetch.
1714
C<end> filter is execute after C<in> filter is executed.
1715

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1718
       PETTERN         EXAMPLE
1719
    1. Column        : author
1720
    2. Table.Column  : book.author
1721
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1722

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

            
1726
You can set multiple filters at once.
1727

            
1728
    $dbi->apply_filter(
1729
        'book',
1730
        [qw/issue_date write_date/] => {
1731
            out => 'tp_to_date',
1732
            in  => 'date_to_tp',
1733
            end => 'tp_to_displaydate'
1734
        }
1735
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1736

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1739
    my $dbi = DBIx::Custom->connect(
1740
        data_source => "dbi:mysql:database=dbname",
1741
        user => 'ken',
1742
        password => '!LFKD%$&',
1743
        dbi_option => {mysql_enable_utf8 => 1}
1744
    );
1745

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1754
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1755
        table => 'book',
1756
        primary_key => 'id',
1757
        join => [
1758
            'inner join company on book.comparny_id = company.id'
1759
        ],
1760
        filter => [
1761
            publish_date => {
1762
                out => 'tp_to_date',
1763
                in => 'date_to_tp',
1764
                end => 'tp_to_displaydate'
1765
            }
1766
        ]
1767
    );
1768

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

            
1772
   $dbi->model('book')->select(...);
1773

            
cleanup
yuki-kimoto authored on 2010-10-17
1774
=head2 C<create_query>
1775
    
1776
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1777
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1778
    );
update document
yuki-kimoto authored on 2009-11-19
1779

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

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

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

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

            
1790
    my $dbh = $dbi->dbh;
1791
    $dbi    = $dbi->dbh($dbh);
1792

            
1793
Get and set database handle of L<DBI>.
1794

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

            
1797
=head2 C<each_column>
1798

            
1799
    $dbi->each_column(
1800
        sub {
1801
            my ($dbi, $table, $column, $column_info) = @_;
1802
            
1803
            my $type = $column_info->{TYPE_NAME};
1804
            
1805
            if ($type eq 'DATE') {
1806
                # ...
1807
            }
1808
        }
1809
    );
1810

            
1811
Iterate all column informations of all table from database.
1812
Argument is callback when one column is found.
1813
Callback receive four arguments, dbi object, table name,
1814
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1815

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1818
    my $result = $dbi->execute(
1819
        "select * from book where {= title} and {like author}",
1820
        param => {title => 'Perl', author => '%Ken%'}
1821
    );
1822

            
1823
Execute SQL, containing tags.
1824
Return value is L<DBIx::Custom::Result> in select statement, or
1825
the count of affected rows in insert, update, delete statement.
1826

            
1827
Tag is turned into the statement containing place holder
1828
before SQL is executed.
1829

            
1830
    select * from where title = ? and author like ?;
1831

            
1832
See also L<Tags/Tags>.
1833

            
1834
The following opitons are currently available.
1835

            
1836
=over 4
1837

            
1838
=item C<filter>
1839

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

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

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

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

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

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

            
1878
Delete statement.
1879

            
1880
The following opitons are currently available.
1881

            
update pod
Yuki Kimoto authored on 2011-03-13
1882
=over 4
1883

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

            
1886
Table name.
1887

            
1888
    $dbi->delete(table => 'book');
1889

            
1890
=item C<where>
1891

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1892
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1893
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1894
    
1895
    # Hash reference
1896
    $dbi->delete(where => {title => 'Perl'});
1897
    
1898
    # DBIx::Custom::Where object
1899
    my $where = $dbi->where(
1900
        clause => ['and', '{= author}', '{like title}'],
1901
        param  => {author => 'Ken', title => '%Perl%'}
1902
    );
1903
    $dbi->delete(where => $where);
1904

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1905
    # Array refrendce (where clause and parameter)
1906
    $dbi->delete(where =>
1907
        [
1908
            ['and', '{= author}', '{like title}'],
1909
            {author => 'Ken', title => '%Perl%'}
1910
        ]
1911
    );
1912
    
update pod
Yuki Kimoto authored on 2011-03-13
1913
=item C<append>
1914

            
1915
Append statement to last of SQL. This is string.
1916

            
1917
    $dbi->delete(append => 'order by title');
1918

            
1919
=item C<filter>
1920

            
1921
Filter, executed before data is send to database. This is array reference.
1922
Filter value is code reference or
1923
filter name registerd by C<register_filter()>.
1924

            
1925
    # Basic
1926
    $dbi->delete(
1927
        filter => [
1928
            title  => sub { uc $_[0] }
1929
            author => sub { uc $_[0] }
1930
        ]
1931
    );
1932
    
1933
    # At once
1934
    $dbi->delete(
1935
        filter => [
1936
            [qw/title author/]  => sub { uc $_[0] }
1937
        ]
1938
    );
1939
    
1940
    # Filter name
1941
    $dbi->delete(
1942
        filter => [
1943
            title  => 'upper_case',
1944
            author => 'upper_case'
1945
        ]
1946
    );
1947

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

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

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

            
1954
Create column clause. The follwoing column clause is created.
1955

            
1956
    book.author as book__author,
1957
    book.title as book__title
1958

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

            
1961
Get L<DBIx::Custom::Query> object instead of executing SQL.
1962
This is true or false value.
1963

            
1964
    my $query = $dbi->delete(query => 1);
1965

            
1966
You can check SQL.
1967

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1970
=back
1971

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

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

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

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

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

            
1983
    $dbi->delete_at(
1984
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1985
        primary_key => 'id',
1986
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1987
    );
1988

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1993
=over 4
1994

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1997
Primary key. This is constant value or array reference.
1998
    
1999
    # Constant value
2000
    $dbi->delete(primary_key => 'id');
2001

            
2002
    # Array reference
2003
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2004

            
2005
This is used to create where clause.
2006

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

            
2009
Where clause, created from primary key information.
2010
This is constant value or array reference.
2011

            
2012
    # Constant value
2013
    $dbi->delete(where => 5);
2014

            
2015
    # Array reference
2016
    $dbi->delete(where => [3, 5]);
2017

            
2018
In first examle, the following SQL is created.
2019

            
2020
    delete from book where id = ?;
2021

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2024
=back
2025

            
cleanup
yuki-kimoto authored on 2010-10-17
2026
=head2 C<insert>
2027

            
update pod
Yuki Kimoto authored on 2011-03-13
2028
    $dbi->insert(
2029
        table  => 'book', 
2030
        param  => {title => 'Perl', author => 'Ken'}
2031
    );
2032

            
2033
Insert statement.
2034

            
2035
The following opitons are currently available.
2036

            
update pod
Yuki Kimoto authored on 2011-03-13
2037
=over 4
2038

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

            
2041
Table name.
2042

            
2043
    $dbi->insert(table => 'book');
2044

            
2045
=item C<param>
2046

            
2047
Insert data. This is hash reference.
2048

            
2049
    $dbi->insert(param => {title => 'Perl'});
2050

            
2051
=item C<append>
2052

            
2053
Append statement to last of SQL. This is string.
2054

            
2055
    $dbi->insert(append => 'order by title');
2056

            
2057
=item C<filter>
2058

            
2059
Filter, executed before data is send to database. This is array reference.
2060
Filter value is code reference or
2061
filter name registerd by C<register_filter()>.
2062

            
2063
    # Basic
2064
    $dbi->insert(
2065
        filter => [
2066
            title  => sub { uc $_[0] }
2067
            author => sub { uc $_[0] }
2068
        ]
2069
    );
2070
    
2071
    # At once
2072
    $dbi->insert(
2073
        filter => [
2074
            [qw/title author/]  => sub { uc $_[0] }
2075
        ]
2076
    );
2077
    
2078
    # Filter name
2079
    $dbi->insert(
2080
        filter => [
2081
            title  => 'upper_case',
2082
            author => 'upper_case'
2083
        ]
2084
    );
2085

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

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

            
2090
Get L<DBIx::Custom::Query> object instead of executing SQL.
2091
This is true or false value.
2092

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2099
=back
2100

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

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

            
2105
    $dbi->insert_at(
2106
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2107
        primary_key => 'id',
2108
        where => '5',
2109
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2110
    );
2111

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2116
=over 4
2117

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

            
2120
Primary key. This is constant value or array reference.
2121
    
2122
    # Constant value
2123
    $dbi->insert(primary_key => 'id');
2124

            
2125
    # Array reference
2126
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2127

            
2128
This is used to create parts of insert data.
2129

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

            
2132
Parts of Insert data, create from primary key information.
2133
This is constant value or array reference.
2134

            
2135
    # Constant value
2136
    $dbi->insert(where => 5);
2137

            
2138
    # Array reference
2139
    $dbi->insert(where => [3, 5]);
2140

            
2141
In first examle, the following SQL is created.
2142

            
2143
    insert into book (id, title) values (?, ?);
2144

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2147
=back
2148

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2149
=head2 C<insert_param_tag>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2150

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2151
    my $insert_param_tag = $dbi->insert_param_tag({title => 'a', age => 2});
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2152

            
2153
Create insert parameter tag.
2154

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2155
    (title, author) values ({? title}, {? author});
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2156

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2164
    lib / MyModel.pm
2165
        / MyModel / book.pm
2166
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2167

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

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

            
2172
    package MyModel;
2173
    
2174
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2175
    
2176
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2177

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2182
    package MyModel::book;
2183
    
2184
    use base 'MyModel';
2185
    
2186
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2187

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2190
    package MyModel::company;
2191
    
2192
    use base 'MyModel';
2193
    
2194
    1;
2195
    
2196
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2197

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

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

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2205
=head2 C<merge_param> EXPERIMENTAL
2206

            
2207
    my $param = $dbi->merge_param({key1 => 1}, {key1 => 1, key2 => 2});
2208

            
2209
Merge paramters.
2210

            
2211
$param:
2212

            
2213
    {key1 => [1, 1], key2 => 2}
2214

            
update pod
Yuki Kimoto authored on 2011-03-13
2215
=head2 C<method> EXPERIMENTAL
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2216

            
2217
    $dbi->method(
2218
        update_or_insert => sub {
2219
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2220
            
2221
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2222
        },
2223
        find_or_create   => sub {
2224
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2225
            
2226
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2227
        }
2228
    );
2229

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

            
2232
    $dbi->update_or_insert;
2233
    $dbi->find_or_create;
2234

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

            
2237
    $dbi->model('book')->method(
2238
        insert => sub { ... },
2239
        update => sub { ... }
2240
    );
2241
    
2242
    my $model = $dbi->model('book');
2243

            
2244
Set and get a L<DBIx::Custom::Model> object,
2245

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

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

            
2250
Create column clause for myself. The follwoing column clause is created.
2251

            
2252
    book.author as author,
2253
    book.title as title
2254

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2257
    my $dbi = DBIx::Custom->new(
2258
        data_source => "dbi:mysql:database=dbname",
2259
        user => 'ken',
2260
        password => '!LFKD%$&',
2261
        dbi_option => {mysql_enable_utf8 => 1}
2262
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2263

            
2264
Create a new L<DBIx::Custom> object.
2265

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

            
2268
    my $not_exists = $dbi->not_exists;
2269

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2273
=head2 C<register_filter>
2274

            
update pod
Yuki Kimoto authored on 2011-03-13
2275
    $dbi->register_filter(
2276
        # Time::Piece object to database DATE format
2277
        tp_to_date => sub {
2278
            my $tp = shift;
2279
            return $tp->strftime('%Y-%m-%d');
2280
        },
2281
        # database DATE format to Time::Piece object
2282
        date_to_tp => sub {
2283
           my $date = shift;
2284
           return Time::Piece->strptime($date, '%Y-%m-%d');
2285
        }
2286
    );
cleanup
yuki-kimoto authored on 2010-10-17
2287
    
update pod
Yuki Kimoto authored on 2011-03-13
2288
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2289

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2292
    $dbi->register_tag(
2293
        update => sub {
2294
            my @columns = @_;
2295
            
2296
            # Update parameters
2297
            my $s = 'set ';
2298
            $s .= "$_ = ?, " for @columns;
2299
            $s =~ s/, $//;
2300
            
2301
            return [$s, \@columns];
2302
        }
2303
    );
cleanup
yuki-kimoto authored on 2010-10-17
2304

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2328
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2329
        table  => 'book',
2330
        column => ['author', 'title'],
2331
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2332
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2333
    
update pod
Yuki Kimoto authored on 2011-03-12
2334
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2335

            
2336
The following opitons are currently available.
2337

            
2338
=over 4
2339

            
2340
=item C<table>
2341

            
2342
Table name.
2343

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

            
2346
=item C<column>
2347

            
2348
Column clause. This is array reference or constant value.
2349

            
2350
    # Hash refernce
2351
    $dbi->select(column => ['author', 'title']);
2352
    
2353
    # Constant value
2354
    $dbi->select(column => 'author');
2355

            
2356
Default is '*' unless C<column> is specified.
2357

            
2358
    # Default
2359
    $dbi->select(column => '*');
2360

            
2361
=item C<where>
2362

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2363
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2364
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2365
    
2366
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2367
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2368
    
update pod
Yuki Kimoto authored on 2011-03-12
2369
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2370
    my $where = $dbi->where(
2371
        clause => ['and', '{= author}', '{like title}'],
2372
        param  => {author => 'Ken', title => '%Perl%'}
2373
    );
update pod
Yuki Kimoto authored on 2011-03-12
2374
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2375

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2376
    # Array refrendce (where clause and parameter)
2377
    $dbi->select(where =>
2378
        [
2379
            ['and', '{= author}', '{like title}'],
2380
            {author => 'Ken', title => '%Perl%'}
2381
        ]
2382
    );
2383
    
update pod
Yuki Kimoto authored on 2011-03-13
2384
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2385

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

            
2388
    $dbi->select(join =>
2389
        [
2390
            'left outer join company on book.company_id = company_id',
2391
            'left outer join location on company.location_id = location.id'
2392
        ]
2393
    );
2394

            
2395
If column cluase or where clause contain table name like "company.name",
2396
needed join clause is used automatically.
2397

            
2398
    $dbi->select(
2399
        table => 'book',
2400
        column => ['company.location_id as company__location_id'],
2401
        where => {'company.name' => 'Orange'},
2402
        join => [
2403
            'left outer join company on book.company_id = company.id',
2404
            'left outer join location on company.location_id = location.id'
2405
        ]
2406
    );
2407

            
2408
In above select, the following SQL is created.
2409

            
2410
    select company.location_id as company__location_id
2411
    from book
2412
      left outer join company on book.company_id = company.id
2413
    where company.name = Orange
2414

            
2415
=item C<append>
2416

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

            
2419
    $dbi->select(append => 'order by title');
2420

            
2421
=item C<filter>
2422

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

            
2427
    # Basic
2428
    $dbi->select(
2429
        filter => [
2430
            title  => sub { uc $_[0] }
2431
            author => sub { uc $_[0] }
2432
        ]
2433
    );
2434
    
2435
    # At once
2436
    $dbi->select(
2437
        filter => [
2438
            [qw/title author/]  => sub { uc $_[0] }
2439
        ]
2440
    );
2441
    
2442
    # Filter name
2443
    $dbi->select(
2444
        filter => [
2445
            title  => 'upper_case',
2446
            author => 'upper_case'
2447
        ]
2448
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2449

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

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

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

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

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

            
2461
    my $sql = $query->sql;
2462

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

            
2465
Specify database data type.
2466

            
2467
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2468
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2469

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

            
2472
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2473

            
update pod
Yuki Kimoto authored on 2011-03-12
2474
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2475

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

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

            
2480
    $dbi->select_at(
2481
        table => 'book',
2482
        primary_key => 'id',
2483
        where => '5'
2484
    );
2485

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2490
=over 4
2491

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2494
Primary key. This is constant value or array reference.
2495
    
2496
    # Constant value
2497
    $dbi->select(primary_key => 'id');
2498

            
2499
    # Array reference
2500
    $dbi->select(primary_key => ['id1', 'id2' ]);
2501

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

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

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

            
2509
    # Constant value
2510
    $dbi->select(where => 5);
2511

            
2512
    # Array reference
2513
    $dbi->select(where => [3, 5]);
2514

            
2515
In first examle, the following SQL is created.
2516

            
2517
    select * from book where id = ?
2518

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2521
=back
2522

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2525
    $dbi->update(
2526
        table  => 'book',
2527
        param  => {title => 'Perl'},
2528
        where  => {id => 4}
2529
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2530

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2535
=over 4
2536

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2539
Table name.
2540

            
2541
    $dbi->update(table => 'book');
2542

            
2543
=item C<param>
2544

            
2545
Update data. This is hash reference.
2546

            
2547
    $dbi->update(param => {title => 'Perl'});
2548

            
2549
=item C<where>
2550

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2551
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2552
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2553
    
2554
    # Hash reference
2555
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2556
    
2557
    # DBIx::Custom::Where object
2558
    my $where = $dbi->where(
2559
        clause => ['and', '{= author}', '{like title}'],
2560
        param  => {author => 'Ken', title => '%Perl%'}
2561
    );
2562
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2563
    
2564
    # Array refrendce (where clause and parameter)
2565
    $dbi->update(where =>
2566
        [
2567
            ['and', '{= author}', '{like title}'],
2568
            {author => 'Ken', title => '%Perl%'}
2569
        ]
2570
    );
update pod
Yuki Kimoto authored on 2011-03-13
2571

            
2572
=item C<append>
2573

            
2574
Append statement to last of SQL. This is string.
2575

            
2576
    $dbi->update(append => 'order by title');
2577

            
2578
=item C<filter>
2579

            
2580
Filter, executed before data is send to database. This is array reference.
2581
Filter value is code reference or
2582
filter name registerd by C<register_filter()>.
2583

            
2584
    # Basic
2585
    $dbi->update(
2586
        filter => [
2587
            title  => sub { uc $_[0] }
2588
            author => sub { uc $_[0] }
2589
        ]
2590
    );
2591
    
2592
    # At once
2593
    $dbi->update(
2594
        filter => [
2595
            [qw/title author/]  => sub { uc $_[0] }
2596
        ]
2597
    );
2598
    
2599
    # Filter name
2600
    $dbi->update(
2601
        filter => [
2602
            title  => 'upper_case',
2603
            author => 'upper_case'
2604
        ]
2605
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2606

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

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

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

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

            
2616
You can check SQL.
2617

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2620
=back
2621

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

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

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

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

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

            
2633
    $dbi->update_at(
2634
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2635
        primary_key => 'id',
2636
        where => '5',
2637
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2638
    );
2639

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2644
=over 4
2645

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

            
2648
Primary key. This is constant value or array reference.
2649
    
2650
    # Constant value
2651
    $dbi->update(primary_key => 'id');
2652

            
2653
    # Array reference
2654
    $dbi->update(primary_key => ['id1', 'id2' ]);
2655

            
2656
This is used to create where clause.
2657

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

            
2660
Where clause, created from primary key information.
2661
This is constant value or array reference.
2662

            
2663
    # Constant value
2664
    $dbi->update(where => 5);
2665

            
2666
    # Array reference
2667
    $dbi->update(where => [3, 5]);
2668

            
2669
In first examle, the following SQL is created.
2670

            
2671
    update book set title = ? where id = ?
2672

            
2673
Place holders are set to 'Perl' and 5.
2674

            
update pod
Yuki Kimoto authored on 2011-03-13
2675
=back
2676

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2677
=head2 C<update_param_tag>
update pod
Yuki Kimoto authored on 2011-03-13
2678

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2679
    my $update_param_tag = $dbi->update_param_tag({title => 'a', age => 2});
update pod
Yuki Kimoto authored on 2011-03-13
2680

            
2681
Create update parameter tag.
2682

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2683
    set title = {? title}, author = {? author}
2684

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2685
You can create tag without 'set '
2686
by C<no_set> option. This option is EXPERIMENTAL.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2687

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2688
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2689
        {title => 'a', age => 2}
2690
        {no_set => 1}
2691
    );
2692

            
2693
    title = {? title}, author = {? author}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2694

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2697
    my $where = $dbi->where(
2698
        clause => ['and', '{= title}', '{= author}'],
2699
        param => {title => 'Perl', author => 'Ken'}
2700
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2701

            
2702
Create a new L<DBIx::Custom::Where> object.
2703

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2711
=head1 Tags
2712

            
2713
The following tags is available.
2714

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

            
2717
Table tag
2718

            
2719
    {table TABLE}    ->    TABLE
2720

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2723
=head2 C<?>
2724

            
2725
Placeholder tag.
2726

            
2727
    {? NAME}    ->   ?
2728

            
2729
=head2 C<=>
2730

            
2731
Equal tag.
2732

            
2733
    {= NAME}    ->   NAME = ?
2734

            
2735
=head2 C<E<lt>E<gt>>
2736

            
2737
Not equal tag.
2738

            
2739
    {<> NAME}   ->   NAME <> ?
2740

            
2741
=head2 C<E<lt>>
2742

            
2743
Lower than tag
2744

            
2745
    {< NAME}    ->   NAME < ?
2746

            
2747
=head2 C<E<gt>>
2748

            
2749
Greater than tag
2750

            
2751
    {> NAME}    ->   NAME > ?
2752

            
2753
=head2 C<E<gt>=>
2754

            
2755
Greater than or equal tag
2756

            
2757
    {>= NAME}   ->   NAME >= ?
2758

            
2759
=head2 C<E<lt>=>
2760

            
2761
Lower than or equal tag
2762

            
2763
    {<= NAME}   ->   NAME <= ?
2764

            
2765
=head2 C<like>
2766

            
2767
Like tag
2768

            
2769
    {like NAME}   ->   NAME like ?
2770

            
2771
=head2 C<in>
2772

            
2773
In tag.
2774

            
2775
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2776

            
2777
=head2 C<insert_param>
2778

            
2779
Insert parameter tag.
2780

            
2781
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2782

            
2783
=head2 C<update_param>
2784

            
2785
Updata parameter tag.
2786

            
2787
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2788

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

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

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

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

            
2798
C<< <kimoto.yuki at gmail.com> >>
2799

            
2800
L<http://github.com/yuki-kimoto/DBIx-Custom>
2801

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2802
=head1 AUTHOR
2803

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

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

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

            
2810
This program is free software; you can redistribute it and/or modify it
2811
under the same terms as Perl itself.
2812

            
2813
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2814

            
2815