DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2818 lines | 67.443kb
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-04-01
844
  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation join param/;
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];
cleanup
Yuki Kimoto authored on 2011-04-01
909

            
910
    # Add table names in param
911
    unshift @$tables, @{$self->_tables(join(' ', keys %$param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
912
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
913
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
914
    my $w = $self->_where($where);
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
915
    $param = keys %$param ? $self->merge_param($param, $w->param)
916
                         : $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
917
    
918
    # String where
919
    my $swhere = "$w";
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
    # Add table names in where clause
922
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
923
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
924
    # Push join
925
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
926
    
cleanup
Yuki Kimoto authored on 2011-03-09
927
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
928
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
929
    
cleanup
Yuki Kimoto authored on 2011-03-08
930
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
931
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
932
    
cleanup
Yuki Kimoto authored on 2011-01-27
933
    # Append statement
934
    push @sql, $append if $append;
935
    
936
    # SQL
937
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
938
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
939
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
940
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
941
    return $query if $args{query};
942
    
packaging one directory
yuki-kimoto authored on 2009-11-16
943
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
944
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
945
        $query,
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
946
        param  => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
947
        table => $tables,
948
        %args
949
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
950
    
951
    return $result;
952
}
953

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1486
=head1 NAME
1487

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

            
1490
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1491

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

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

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

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

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

            
1559
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1560

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1571
=item *
1572

            
1573
Filter when data is send or receive.
1574

            
1575
=item *
1576

            
1577
Data filtering system
1578

            
1579
=item *
1580

            
1581
Model support.
1582

            
1583
=item *
1584

            
1585
Generate where clause dinamically.
1586

            
1587
=item *
1588

            
1589
Generate join clause dinamically.
1590

            
1591
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1592

            
1593
=head1 GUIDE
1594

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

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

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

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

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

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

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

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

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

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

            
1618
=head2 C<default_dbi_option>
1619

            
1620
    my $default_dbi_option = $dbi->default_dbi_option;
1621
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1622

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

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

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

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

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

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

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

            
1644
    my $models = $dbi->models;
1645
    $dbi       = $dbi->models(\%models);
1646

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1649
=head2 C<password>
1650

            
1651
    my $password = $dbi->password;
1652
    $dbi         = $dbi->password('lkj&le`@s');
1653

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

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

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

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

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

            
1665
     my reserved_word_quote = $dbi->reserved_word_quote;
1666
     $dbi                   = $dbi->reserved_word_quote('"');
1667

            
1668
Quote for reserved word, default to empty string.
1669

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1687
    my $user = $dbi->user;
1688
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1689

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

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

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

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

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

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

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

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

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

            
1729
You can set multiple filters at once.
1730

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

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

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

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

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

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

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

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

            
1775
   $dbi->model('book')->select(...);
1776

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

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

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

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

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

            
1793
    my $dbh = $dbi->dbh;
1794
    $dbi    = $dbi->dbh($dbh);
1795

            
1796
Get and set database handle of L<DBI>.
1797

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

            
1800
=head2 C<each_column>
1801

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

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

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

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

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

            
1830
Tag is turned into the statement containing place holder
1831
before SQL is executed.
1832

            
1833
    select * from where title = ? and author like ?;
1834

            
1835
See also L<Tags/Tags>.
1836

            
1837
The following opitons are currently available.
1838

            
1839
=over 4
1840

            
1841
=item C<filter>
1842

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

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

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

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

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

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

            
1881
Delete statement.
1882

            
1883
The following opitons are currently available.
1884

            
update pod
Yuki Kimoto authored on 2011-03-13
1885
=over 4
1886

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

            
1889
Table name.
1890

            
1891
    $dbi->delete(table => 'book');
1892

            
1893
=item C<where>
1894

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

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

            
1918
Append statement to last of SQL. This is string.
1919

            
1920
    $dbi->delete(append => 'order by title');
1921

            
1922
=item C<filter>
1923

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

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

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

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

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

            
1957
Create column clause. The follwoing column clause is created.
1958

            
1959
    book.author as book__author,
1960
    book.title as book__title
1961

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

            
1964
Get L<DBIx::Custom::Query> object instead of executing SQL.
1965
This is true or false value.
1966

            
1967
    my $query = $dbi->delete(query => 1);
1968

            
1969
You can check SQL.
1970

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1973
=back
1974

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

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

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

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

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

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

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

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

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

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

            
2005
    # Array reference
2006
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2007

            
2008
This is used to create where clause.
2009

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

            
2012
Where clause, created from primary key information.
2013
This is constant value or array reference.
2014

            
2015
    # Constant value
2016
    $dbi->delete(where => 5);
2017

            
2018
    # Array reference
2019
    $dbi->delete(where => [3, 5]);
2020

            
2021
In first examle, the following SQL is created.
2022

            
2023
    delete from book where id = ?;
2024

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2027
=back
2028

            
cleanup
yuki-kimoto authored on 2010-10-17
2029
=head2 C<insert>
2030

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

            
2036
Insert statement.
2037

            
2038
The following opitons are currently available.
2039

            
update pod
Yuki Kimoto authored on 2011-03-13
2040
=over 4
2041

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

            
2044
Table name.
2045

            
2046
    $dbi->insert(table => 'book');
2047

            
2048
=item C<param>
2049

            
2050
Insert data. This is hash reference.
2051

            
2052
    $dbi->insert(param => {title => 'Perl'});
2053

            
2054
=item C<append>
2055

            
2056
Append statement to last of SQL. This is string.
2057

            
2058
    $dbi->insert(append => 'order by title');
2059

            
2060
=item C<filter>
2061

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

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

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

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

            
2093
Get L<DBIx::Custom::Query> object instead of executing SQL.
2094
This is true or false value.
2095

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2102
=back
2103

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2119
=over 4
2120

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

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

            
2128
    # Array reference
2129
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2130

            
2131
This is used to create parts of insert data.
2132

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

            
2135
Parts of Insert data, create from primary key information.
2136
This is constant value or array reference.
2137

            
2138
    # Constant value
2139
    $dbi->insert(where => 5);
2140

            
2141
    # Array reference
2142
    $dbi->insert(where => [3, 5]);
2143

            
2144
In first examle, the following SQL is created.
2145

            
2146
    insert into book (id, title) values (?, ?);
2147

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2150
=back
2151

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

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

            
2156
Create insert parameter tag.
2157

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2212
Merge paramters.
2213

            
2214
$param:
2215

            
2216
    {key1 => [1, 1], key2 => 2}
2217

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

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

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

            
2235
    $dbi->update_or_insert;
2236
    $dbi->find_or_create;
2237

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

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

            
2247
Set and get a L<DBIx::Custom::Model> object,
2248

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

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

            
2253
Create column clause for myself. The follwoing column clause is created.
2254

            
2255
    book.author as author,
2256
    book.title as title
2257

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

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

            
2267
Create a new L<DBIx::Custom> object.
2268

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

            
2271
    my $not_exists = $dbi->not_exists;
2272

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2276
=head2 C<register_filter>
2277

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2339
The following opitons are currently available.
2340

            
2341
=over 4
2342

            
2343
=item C<table>
2344

            
2345
Table name.
2346

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

            
2349
=item C<column>
2350

            
2351
Column clause. This is array reference or constant value.
2352

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

            
2359
Default is '*' unless C<column> is specified.
2360

            
2361
    # Default
2362
    $dbi->select(column => '*');
2363

            
2364
=item C<where>
2365

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

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

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

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

            
2398
If column cluase or where clause contain table name like "company.name",
2399
needed join clause is used automatically.
2400

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

            
2411
In above select, the following SQL is created.
2412

            
2413
    select company.location_id as company__location_id
2414
    from book
2415
      left outer join company on book.company_id = company.id
2416
    where company.name = Orange
2417

            
2418
=item C<append>
2419

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

            
2422
    $dbi->select(append => 'order by title');
2423

            
2424
=item C<filter>
2425

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

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

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

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

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

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

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

            
2464
    my $sql = $query->sql;
2465

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

            
2468
Specify database data type.
2469

            
2470
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2471
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2472

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

            
2475
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2476

            
update pod
Yuki Kimoto authored on 2011-03-12
2477
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2478

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

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

            
2483
    $dbi->select_at(
2484
        table => 'book',
2485
        primary_key => 'id',
2486
        where => '5'
2487
    );
2488

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

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

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

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

            
2502
    # Array reference
2503
    $dbi->select(primary_key => ['id1', 'id2' ]);
2504

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

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

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

            
2512
    # Constant value
2513
    $dbi->select(where => 5);
2514

            
2515
    # Array reference
2516
    $dbi->select(where => [3, 5]);
2517

            
2518
In first examle, the following SQL is created.
2519

            
2520
    select * from book where id = ?
2521

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2524
=back
2525

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2542
Table name.
2543

            
2544
    $dbi->update(table => 'book');
2545

            
2546
=item C<param>
2547

            
2548
Update data. This is hash reference.
2549

            
2550
    $dbi->update(param => {title => 'Perl'});
2551

            
2552
=item C<where>
2553

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

            
2575
=item C<append>
2576

            
2577
Append statement to last of SQL. This is string.
2578

            
2579
    $dbi->update(append => 'order by title');
2580

            
2581
=item C<filter>
2582

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

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

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

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

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

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

            
2619
You can check SQL.
2620

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

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2647
=over 4
2648

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

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

            
2656
    # Array reference
2657
    $dbi->update(primary_key => ['id1', 'id2' ]);
2658

            
2659
This is used to create where clause.
2660

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

            
2663
Where clause, created from primary key information.
2664
This is constant value or array reference.
2665

            
2666
    # Constant value
2667
    $dbi->update(where => 5);
2668

            
2669
    # Array reference
2670
    $dbi->update(where => [3, 5]);
2671

            
2672
In first examle, the following SQL is created.
2673

            
2674
    update book set title = ? where id = ?
2675

            
2676
Place holders are set to 'Perl' and 5.
2677

            
update pod
Yuki Kimoto authored on 2011-03-13
2678
=back
2679

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

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

            
2684
Create update parameter tag.
2685

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

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

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

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

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

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

            
2705
Create a new L<DBIx::Custom::Where> object.
2706

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2714
=head1 Tags
2715

            
2716
The following tags is available.
2717

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

            
2720
Table tag
2721

            
2722
    {table TABLE}    ->    TABLE
2723

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2726
=head2 C<?>
2727

            
2728
Placeholder tag.
2729

            
2730
    {? NAME}    ->   ?
2731

            
2732
=head2 C<=>
2733

            
2734
Equal tag.
2735

            
2736
    {= NAME}    ->   NAME = ?
2737

            
2738
=head2 C<E<lt>E<gt>>
2739

            
2740
Not equal tag.
2741

            
2742
    {<> NAME}   ->   NAME <> ?
2743

            
2744
=head2 C<E<lt>>
2745

            
2746
Lower than tag
2747

            
2748
    {< NAME}    ->   NAME < ?
2749

            
2750
=head2 C<E<gt>>
2751

            
2752
Greater than tag
2753

            
2754
    {> NAME}    ->   NAME > ?
2755

            
2756
=head2 C<E<gt>=>
2757

            
2758
Greater than or equal tag
2759

            
2760
    {>= NAME}   ->   NAME >= ?
2761

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

            
2764
Lower than or equal tag
2765

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

            
2768
=head2 C<like>
2769

            
2770
Like tag
2771

            
2772
    {like NAME}   ->   NAME like ?
2773

            
2774
=head2 C<in>
2775

            
2776
In tag.
2777

            
2778
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2779

            
2780
=head2 C<insert_param>
2781

            
2782
Insert parameter tag.
2783

            
2784
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2785

            
2786
=head2 C<update_param>
2787

            
2788
Updata parameter tag.
2789

            
2790
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2791

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

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

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

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

            
2801
C<< <kimoto.yuki at gmail.com> >>
2802

            
2803
L<http://github.com/yuki-kimoto/DBIx-Custom>
2804

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2805
=head1 AUTHOR
2806

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

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

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

            
2813
This program is free software; you can redistribute it and/or modify it
2814
under the same terms as Perl itself.
2815

            
2816
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2817

            
2818