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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
3
our $VERSION = '0.1669';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

            
5
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
6
use strict;
7
use warnings;
8

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
9
use base 'Object::Simple';
many change
yuki-kimoto authored on 2010-02-11
10

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
19
use DBIx::Custom::Util;
update document
yuki-kimoto authored on 2010-05-27
20
use Encode qw/encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
21

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
849
    # Quote for reserved word
850
    my $q = $self->reserved_word_quote;
packaging one directory
yuki-kimoto authored on 2009-11-16
851
    
cleanup
Yuki Kimoto authored on 2011-03-09
852
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
853
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
854
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
855
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
856
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
857
    
refactoring select
yuki-kimoto authored on 2010-04-28
858
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
859
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
860
    my $tables = ref $table eq 'ARRAY' ? $table
861
               : defined $table ? [$table]
862
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
863
    my $columns   = delete $args{column};
864
    my $where     = delete $args{where} || {};
865
    my $append    = delete $args{append};
866
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
867
    croak qq{"join" must be array reference}
868
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
869
    my $relation = delete $args{relation};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
870
    
cleanup
Yuki Kimoto authored on 2011-03-09
871
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
872
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
873
    
cleanup
Yuki Kimoto authored on 2011-01-27
874
    # SQL stack
875
    my @sql;
876
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
877
    
cleanup
Yuki Kimoto authored on 2011-03-30
878
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
879

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

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

            
995
sub select_at {
996
    my ($self, %args) = @_;
997
    
cleanup
Yuki Kimoto authored on 2011-03-09
998
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
999
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1000
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1001
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1002
    }
1003
    
1004
    # Primary key
1005
    my $primary_keys = delete $args{primary_key};
1006
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1007
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
1008
    # Table
1009
    croak qq{"table" option must be specified} unless $args{table};
1010
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1011
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1012
    # Where clause
1013
    my $where = {};
1014
    if (exists $args{where}) {
1015
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1016
        
1017
        croak qq{"where" must be constant value or array reference}
1018
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
1019
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1020
        $where_columns = [$where_columns] unless ref $where_columns;
1021
        
1022
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
1023
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1024
        }
1025
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1026
    
1027
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1028
        my $param = delete $args{param};
1029
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1030
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1031
        }
1032
    }
1033
    
1034
    return $self->select(where => $where, %args);
1035
}
1036

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1037
sub setup_model {
1038
    my $self = shift;
1039
    
1040
    $self->each_column(
1041
        sub {
1042
            my ($self, $table, $column, $column_info) = @_;
1043
            
1044
            if (my $model = $self->models->{$table}) {
1045
                push @{$model->columns}, $column;
1046
            }
1047
        }
1048
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1049
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1050
}
1051

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

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

            
1058
    # Quote for reserved word
1059
    my $q = $self->reserved_word_quote;
version 0.0901
yuki-kimoto authored on 2009-12-17
1060
    
cleanup
Yuki Kimoto authored on 2011-03-09
1061
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1062
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1063
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1064
          unless $UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1065
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1066
    
cleanup
yuki-kimoto authored on 2010-10-17
1067
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1068
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1069
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1070
    my $param            = delete $args{param} || {};
1071
    my $where            = delete $args{where} || {};
1072
    my $append           = delete $args{append} || '';
1073
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1074
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1075
    # Columns
1076
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1077
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1078
    foreach my $column (keys %$param) {
1079
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1080
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1081
          $column = "$q$column$q";
1082
          $column =~ s/\./$q.$q/;
1083
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1084
    }
1085
        
cleanup
yuki-kimoto authored on 2010-10-17
1086
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1087
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1088

            
1089
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1090
    my $w = $self->_where($where);
1091
    $where = $w->param;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1092
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1093
    # String where
1094
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1095
    
1096
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1097
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1098
    
cleanup
Yuki Kimoto authored on 2011-01-27
1099
    # SQL stack
1100
    my @sql;
1101
    
1102
    # Update
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1103
    push @sql, "update $q$table$q $update_clause $swhere";
cleanup
Yuki Kimoto authored on 2011-01-27
1104
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1105
    
cleanup
yuki-kimoto authored on 2010-10-17
1106
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1107
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1108
        
cleanup
yuki-kimoto authored on 2010-10-17
1109
        if (exists $param->{$wkey}) {
1110
            $param->{$wkey} = [$param->{$wkey}]
1111
              unless ref $param->{$wkey} eq 'ARRAY';
1112
            
1113
            push @{$param->{$wkey}}, $where->{$wkey};
1114
        }
1115
        else {
1116
            $param->{$wkey} = $where->{$wkey};
1117
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1118
    }
cleanup
yuki-kimoto authored on 2010-10-17
1119
    
cleanup
Yuki Kimoto authored on 2011-01-27
1120
    # SQL
1121
    my $sql = join(' ', @sql);
1122
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1123
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1124
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1125
    return $query if $args{query};
1126
    
cleanup
yuki-kimoto authored on 2010-10-17
1127
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1128
    my $ret_val = $self->execute(
1129
        $query,
1130
        param  => $param, 
1131
        table => $table,
1132
        %args
1133
    );
cleanup
yuki-kimoto authored on 2010-10-17
1134
    
1135
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1136
}
1137

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

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

            
1142
sub update_at {
1143
    my ($self, %args) = @_;
1144
    
cleanup
Yuki Kimoto authored on 2011-03-09
1145
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1146
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1147
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1148
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1149
    }
1150
    
1151
    # Primary key
1152
    my $primary_keys = delete $args{primary_key};
1153
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1154
    
1155
    # Where clause
1156
    my $where = {};
1157
    my $param = {};
1158
    
1159
    if (exists $args{where}) {
1160
        my $where_columns = delete $args{where};
1161
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1162

            
1163
        croak qq{"where" must be constant value or array reference}
1164
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1165
        
1166
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1167
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1168
        }
1169
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1170
    
1171
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1172
        $param = delete $args{param};
1173
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1174
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1175
        }
1176
    }
1177
    
1178
    return $self->update(where => $where, param => $param, %args);
1179
}
1180

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1181
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1182
    my ($self, $param, $opt) = @_;
1183
    
1184
    # Insert parameter tag
1185
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1186
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1187
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1188
    my $q = $self->reserved_word_quote;
1189
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1190
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1191
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1192
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1193
        
1194
        my $c = "$q$column$q";
1195
        $c =~ s/\./$q.$q/;
1196
        
1197
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1198
    }
1199
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1200
    my $clause;
1201
    $clause .= 'set ' unless $opt->{no_set};
1202
    $clause .= join(', ', @params);
1203
    
1204
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1205
}
1206

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

            
1210
    return DBIx::Custom::Where->new(
1211
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1212
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1213
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1214
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1215
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1216
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1217

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1218
sub _bind {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1219
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1220
    
cleanup
Yuki Kimoto authored on 2011-01-12
1221
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1222
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1223
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1224
    # Build bind values
1225
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1226
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1227
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1228
        
1229
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1230
        my $value;
1231
        if(ref $params->{$column} eq 'ARRAY') {
1232
            my $i = $count->{$column} || 0;
1233
            $i += $not_exists->{$column} || 0;
1234
            my $found;
1235
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1236
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1237
                    $not_exists->{$column}++;
1238
                }
1239
                else  {
1240
                    $value = $params->{$column}->[$k];
1241
                    $found = 1;
1242
                    last
1243
                }
1244
            }
1245
            next unless $found;
1246
        }
1247
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1248
        
cleanup
Yuki Kimoto authored on 2011-01-12
1249
        # Filter
1250
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1251
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1252
        # Type
1253
        push @$bind, {
1254
            value => $f ? $f->($value) : $value,
1255
            type => $type->{$column}
1256
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1257
        
1258
        # Count up 
1259
        $count->{$column}++;
1260
    }
1261
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1262
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1263
}
1264

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1265
sub _connect {
1266
    my $self = shift;
1267
    
1268
    # Attributes
1269
    my $data_source = $self->data_source;
1270
    croak qq{"data_source" must be specified to connect()"}
1271
      unless $data_source;
1272
    my $user        = $self->user;
1273
    my $password    = $self->password;
1274
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1275
    
1276
    # Connect
1277
    my $dbh = eval {DBI->connect(
1278
        $data_source,
1279
        $user,
1280
        $password,
1281
        {
1282
            %{$self->default_dbi_option},
1283
            %$dbi_option
1284
        }
1285
    )};
1286
    
1287
    # Connect error
1288
    croak $@ if $@;
1289
    
1290
    return $dbh;
1291
}
1292

            
cleanup
yuki-kimoto authored on 2010-10-17
1293
sub _croak {
1294
    my ($self, $error, $append) = @_;
1295
    $append ||= "";
1296
    
1297
    # Verbose
1298
    if ($Carp::Verbose) { croak $error }
1299
    
1300
    # Not verbose
1301
    else {
1302
        
1303
        # Remove line and module infromation
1304
        my $at_pos = rindex($error, ' at ');
1305
        $error = substr($error, 0, $at_pos);
1306
        $error =~ s/\s+$//;
1307
        
1308
        croak "$error$append";
1309
    }
1310
}
1311

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1312
sub _need_tables {
1313
    my ($self, $tree, $need_tables, $tables) = @_;
1314
    
1315
    foreach my $table (@$tables) {
1316
        
1317
        if ($tree->{$table}) {
1318
            $need_tables->{$table} = 1;
1319
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1320
        }
1321
    }
1322
}
1323

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1324
sub _tables {
1325
    my ($self, $source) = @_;
1326
    
1327
    my $tables = [];
1328
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1329
    my $safety_character = $self->safety_character;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1330
    my $q = $self->reserved_word_quote;
1331
    my $q_re = quotemeta($q);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1332
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1333
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1334
                      : qr/\b([$safety_character]+)\./;
1335
    while ($source =~ /$table_re/g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1336
        push @$tables, $1;
1337
    }
1338
    
1339
    return $tables;
1340
}
1341

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1342
sub _push_join {
1343
    my ($self, $sql, $join, $join_tables) = @_;
1344
    
1345
    return unless @$join;
1346
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1347
    my $q = $self->reserved_word_quote;
1348
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1349
    my $tree = {};
1350
    
1351
    for (my $i = 0; $i < @$join; $i++) {
1352
        
1353
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1354
        my $q_re = quotemeta($q);
1355
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1356
                         : qr/\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/;
1357
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1358
            
1359
            my $table1 = $1;
1360
            my $table2 = $2;
1361
            
1362
            croak qq{right side table of "$join_clause" must be uniq}
1363
              if exists $tree->{$table2};
1364
            
1365
            $tree->{$table2}
1366
              = {position => $i, parent => $table1, join => $join_clause};
1367
        }
1368
        else {
1369
            croak qq{join "$join_clause" must be two table name};
1370
        }
1371
    }
1372
    
1373
    my $need_tables = {};
1374
    $self->_need_tables($tree, $need_tables, $join_tables);
1375
    
1376
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1377

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1378
    foreach my $need_table (@need_tables) {
1379
        push @$sql, $tree->{$need_table}{join};
1380
    }
1381
}
cleanup
Yuki Kimoto authored on 2011-03-08
1382

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1383
sub _where {
1384
    my ($self, $where) = @_;
1385
    
1386
    my $w;
1387
    if (ref $where eq 'HASH') {
1388
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1389
        my $q = $self->reserved_word_quote;
1390
        foreach my $column (keys %$where) {
1391
            $column = "$q$column$q";
1392
            $column =~ s/\./$q.$q/;
1393
            push @$clause, "{= $column}" for keys %$where;
1394
        }
1395
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1396
        $w = $self->where(clause => $clause, param => $where);
1397
    }
1398
    elsif (ref $where eq 'DBIx::Custom::Where') {
1399
        $w = $where;
1400
    }
1401
    elsif (ref $where eq 'ARRAY') {
1402
        $w = $self->where(
1403
            clause => $where->[0],
1404
            param  => $where->[1]
1405
        );
1406
    }
1407
    
1408
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1409
          qq{or array reference, which contains where clause and paramter}
1410
      unless ref $w eq 'DBIx::Custom::Where';
1411
    
1412
    return $w;
1413
}
1414

            
cleanup
Yuki Kimoto authored on 2011-01-25
1415
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1416
__PACKAGE__->attr(
1417
    dbi_options => sub { {} },
1418
    filter_check  => 1
1419
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1420

            
cleanup
Yuki Kimoto authored on 2011-01-25
1421
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1422
sub default_bind_filter {
1423
    my $self = shift;
1424
    
1425
    if (@_) {
1426
        my $fname = $_[0];
1427
        
1428
        if (@_ && !$fname) {
1429
            $self->{default_out_filter} = undef;
1430
        }
1431
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1432
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1433
              unless exists $self->filters->{$fname};
1434
        
1435
            $self->{default_out_filter} = $self->filters->{$fname};
1436
        }
1437
        return $self;
1438
    }
1439
    
1440
    return $self->{default_out_filter};
1441
}
1442

            
cleanup
Yuki Kimoto authored on 2011-01-25
1443
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1444
sub default_fetch_filter {
1445
    my $self = shift;
1446
    
1447
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1448
        my $fname = $_[0];
1449

            
cleanup
Yuki Kimoto authored on 2011-01-12
1450
        if (@_ && !$fname) {
1451
            $self->{default_in_filter} = undef;
1452
        }
1453
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1454
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1455
              unless exists $self->filters->{$fname};
1456
        
1457
            $self->{default_in_filter} = $self->filters->{$fname};
1458
        }
1459
        
1460
        return $self;
1461
    }
1462
    
many changed
Yuki Kimoto authored on 2011-01-23
1463
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1464
}
1465

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1466
# DEPRECATED!
1467
sub insert_param {
1468
    warn "insert_param is renamed to insert_param_tag."
1469
       . " insert_param is DEPRECATED!";
1470
    return shift->insert_param_tag(@_);
1471
}
1472

            
cleanup
Yuki Kimoto authored on 2011-01-25
1473
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1474
sub register_tag_processor {
1475
    return shift->query_builder->register_tag_processor(@_);
1476
}
1477

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1478
# DEPRECATED!
1479
sub update_param {
1480
    warn "update_param is renamed to update_param_tag."
1481
       . " update_param is DEPRECATED!";
1482
    return shift->update_param_tag(@_);
1483
}
cleanup
Yuki Kimoto authored on 2011-03-08
1484
# DEPRECATED!
1485
sub _push_relation {
1486
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1487
    
1488
    if (keys %{$relation || {}}) {
1489
        push @$sql, $need_where ? 'where' : 'and';
1490
        foreach my $rcolumn (keys %$relation) {
1491
            my $table1 = (split (/\./, $rcolumn))[0];
1492
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1493
            push @$tables, ($table1, $table2);
1494
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1495
        }
1496
    }
1497
    pop @$sql if $sql->[-1] eq 'and';    
1498
}
1499

            
1500
# DEPRECATED!
1501
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1502
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1503
    
1504
    if (keys %{$relation || {}}) {
1505
        foreach my $rcolumn (keys %$relation) {
1506
            my $table1 = (split (/\./, $rcolumn))[0];
1507
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1508
            my $table1_exists;
1509
            my $table2_exists;
1510
            foreach my $table (@$tables) {
1511
                $table1_exists = 1 if $table eq $table1;
1512
                $table2_exists = 1 if $table eq $table2;
1513
            }
1514
            unshift @$tables, $table1 unless $table1_exists;
1515
            unshift @$tables, $table2 unless $table2_exists;
1516
        }
1517
    }
1518
}
1519

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1522
=head1 NAME
1523

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

            
1526
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1527

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1528
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1529
    
1530
    # Connect
1531
    my $dbi = DBIx::Custom->connect(
1532
        data_source => "dbi:mysql:database=dbname",
1533
        user => 'ken',
1534
        password => '!LFKD%$&',
1535
        dbi_option => {mysql_enable_utf8 => 1}
1536
    );
cleanup
yuki-kimoto authored on 2010-08-05
1537

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1538
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1539
    $dbi->insert(
1540
        table  => 'book',
1541
        param  => {title => 'Perl', author => 'Ken'}
1542
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1543
    
1544
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1545
    $dbi->update(
1546
        table  => 'book', 
1547
        param  => {title => 'Perl', author => 'Ken'}, 
1548
        where  => {id => 5},
1549
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1550
    
1551
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1552
    $dbi->delete(
1553
        table  => 'book',
1554
        where  => {author => 'Ken'},
1555
    );
cleanup
yuki-kimoto authored on 2010-08-05
1556

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1563
    # Select, more complex
1564
    my $result = $dbi->select(
1565
        table  => 'book',
1566
        column => [
1567
            'book.author as book__author',
1568
            'company.name as company__name'
1569
        ],
1570
        where  => {'book.author' => 'Ken'},
1571
        join => ['left outer join company on book.company_id = company.id'],
1572
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1573
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1574
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1575
    # Fetch
1576
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1577
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1578
    }
1579
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1580
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1581
    while (my $row = $result->fetch_hash) {
1582
        
1583
    }
1584
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1585
    # Execute SQL with parameter.
1586
    $dbi->execute(
1587
        "select id from book where {= author} and {like title}",
1588
        param  => {author => 'ken', title => '%Perl%'}
1589
    );
1590
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1591
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1592

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

            
1595
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1596

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1601
There are many basic methods to execute various queries.
1602
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1603
C<delete_all()>, C<select()>,
1604
C<insert_at()>, C<update_at()>, 
1605
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1606

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1607
=item *
1608

            
1609
Filter when data is send or receive.
1610

            
1611
=item *
1612

            
1613
Data filtering system
1614

            
1615
=item *
1616

            
1617
Model support.
1618

            
1619
=item *
1620

            
1621
Generate where clause dinamically.
1622

            
1623
=item *
1624

            
1625
Generate join clause dinamically.
1626

            
1627
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1628

            
1629
=head1 GUIDE
1630

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

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

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

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

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

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

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

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

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

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

            
1654
=head2 C<default_dbi_option>
1655

            
1656
    my $default_dbi_option = $dbi->default_dbi_option;
1657
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1658

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1662
    {
1663
        RaiseError => 1,
1664
        PrintError => 0,
1665
        AutoCommit => 1,
1666
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1667

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

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

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

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

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

            
1680
    my $models = $dbi->models;
1681
    $dbi       = $dbi->models(\%models);
1682

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

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

            
1687
    my $password = $dbi->password;
1688
    $dbi         = $dbi->password('lkj&le`@s');
1689

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

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

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

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

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

            
1701
     my reserved_word_quote = $dbi->reserved_word_quote;
1702
     $dbi                   = $dbi->reserved_word_quote('"');
1703

            
1704
Quote for reserved word, default to empty string.
1705

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1723
    my $user = $dbi->user;
1724
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1725

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1736
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1737
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1738
        'issue_date' => {
1739
            out => 'tp_to_date',
1740
            in  => 'date_to_tp',
1741
            end => 'tp_to_displaydate'
1742
        },
1743
        'write_date' => {
1744
            out => 'tp_to_date',
1745
            in  => 'date_to_tp',
1746
            end => 'tp_to_displaydate'
1747
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1748
    );
1749

            
update pod
Yuki Kimoto authored on 2011-03-13
1750
Apply filter to columns.
1751
C<out> filter is executed before data is send to database.
1752
C<in> filter is executed after a row is fetch.
1753
C<end> filter is execute after C<in> filter is executed.
1754

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1757
       PETTERN         EXAMPLE
1758
    1. Column        : author
1759
    2. Table.Column  : book.author
1760
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1761

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

            
1765
You can set multiple filters at once.
1766

            
1767
    $dbi->apply_filter(
1768
        'book',
1769
        [qw/issue_date write_date/] => {
1770
            out => 'tp_to_date',
1771
            in  => 'date_to_tp',
1772
            end => 'tp_to_displaydate'
1773
        }
1774
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1775

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1778
    my $dbi = DBIx::Custom->connect(
1779
        data_source => "dbi:mysql:database=dbname",
1780
        user => 'ken',
1781
        password => '!LFKD%$&',
1782
        dbi_option => {mysql_enable_utf8 => 1}
1783
    );
1784

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1793
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1794
        table => 'book',
1795
        primary_key => 'id',
1796
        join => [
1797
            'inner join company on book.comparny_id = company.id'
1798
        ],
1799
        filter => [
1800
            publish_date => {
1801
                out => 'tp_to_date',
1802
                in => 'date_to_tp',
1803
                end => 'tp_to_displaydate'
1804
            }
1805
        ]
1806
    );
1807

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

            
1811
   $dbi->model('book')->select(...);
1812

            
cleanup
yuki-kimoto authored on 2010-10-17
1813
=head2 C<create_query>
1814
    
1815
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1816
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1817
    );
update document
yuki-kimoto authored on 2009-11-19
1818

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

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

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

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

            
1829
    my $dbh = $dbi->dbh;
1830
    $dbi    = $dbi->dbh($dbh);
1831

            
1832
Get and set database handle of L<DBI>.
1833

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

            
1836
=head2 C<each_column>
1837

            
1838
    $dbi->each_column(
1839
        sub {
1840
            my ($dbi, $table, $column, $column_info) = @_;
1841
            
1842
            my $type = $column_info->{TYPE_NAME};
1843
            
1844
            if ($type eq 'DATE') {
1845
                # ...
1846
            }
1847
        }
1848
    );
1849

            
1850
Iterate all column informations of all table from database.
1851
Argument is callback when one column is found.
1852
Callback receive four arguments, dbi object, table name,
1853
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1854

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1857
    my $result = $dbi->execute(
1858
        "select * from book where {= title} and {like author}",
1859
        param => {title => 'Perl', author => '%Ken%'}
1860
    );
1861

            
1862
Execute SQL, containing tags.
1863
Return value is L<DBIx::Custom::Result> in select statement, or
1864
the count of affected rows in insert, update, delete statement.
1865

            
1866
Tag is turned into the statement containing place holder
1867
before SQL is executed.
1868

            
1869
    select * from where title = ? and author like ?;
1870

            
1871
See also L<Tags/Tags>.
1872

            
1873
The following opitons are currently available.
1874

            
1875
=over 4
1876

            
1877
=item C<filter>
1878

            
1879
Filter, executed before data is send to database. This is array reference.
1880
Filter value is code reference or
1881
filter name registerd by C<register_filter()>.
1882

            
1883
    # Basic
1884
    $dbi->execute(
1885
        $sql,
1886
        filter => [
1887
            title  => sub { uc $_[0] }
1888
            author => sub { uc $_[0] }
1889
        ]
1890
    );
1891
    
1892
    # At once
1893
    $dbi->execute(
1894
        $sql,
1895
        filter => [
1896
            [qw/title author/]  => sub { uc $_[0] }
1897
        ]
1898
    );
1899
    
1900
    # Filter name
1901
    $dbi->execute(
1902
        $sql,
1903
        filter => [
1904
            title  => 'upper_case',
1905
            author => 'upper_case'
1906
        ]
1907
    );
1908

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

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

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

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

            
1917
Delete statement.
1918

            
1919
The following opitons are currently available.
1920

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

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

            
1925
Table name.
1926

            
1927
    $dbi->delete(table => 'book');
1928

            
1929
=item C<where>
1930

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1931
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1932
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1933
    
1934
    # Hash reference
1935
    $dbi->delete(where => {title => 'Perl'});
1936
    
1937
    # DBIx::Custom::Where object
1938
    my $where = $dbi->where(
1939
        clause => ['and', '{= author}', '{like title}'],
1940
        param  => {author => 'Ken', title => '%Perl%'}
1941
    );
1942
    $dbi->delete(where => $where);
1943

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1944
    # Array refrendce (where clause and parameter)
1945
    $dbi->delete(where =>
1946
        [
1947
            ['and', '{= author}', '{like title}'],
1948
            {author => 'Ken', title => '%Perl%'}
1949
        ]
1950
    );
1951
    
update pod
Yuki Kimoto authored on 2011-03-13
1952
=item C<append>
1953

            
1954
Append statement to last of SQL. This is string.
1955

            
1956
    $dbi->delete(append => 'order by title');
1957

            
1958
=item C<filter>
1959

            
1960
Filter, executed before data is send to database. This is array reference.
1961
Filter value is code reference or
1962
filter name registerd by C<register_filter()>.
1963

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

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

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

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

            
1993
Create column clause. The follwoing column clause is created.
1994

            
1995
    book.author as book__author,
1996
    book.title as book__title
1997

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

            
2000
Get L<DBIx::Custom::Query> object instead of executing SQL.
2001
This is true or false value.
2002

            
2003
    my $query = $dbi->delete(query => 1);
2004

            
2005
You can check SQL.
2006

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2009
=back
2010

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

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

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

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

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

            
2022
    $dbi->delete_at(
2023
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2024
        primary_key => 'id',
2025
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2026
    );
2027

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2036
Primary key. This is constant value or array reference.
2037
    
2038
    # Constant value
2039
    $dbi->delete(primary_key => 'id');
2040

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

            
2044
This is used to create where clause.
2045

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

            
2048
Where clause, created from primary key information.
2049
This is constant value or array reference.
2050

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

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

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

            
2059
    delete from book where id = ?;
2060

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2065
=head2 C<insert>
2066

            
update pod
Yuki Kimoto authored on 2011-03-13
2067
    $dbi->insert(
2068
        table  => 'book', 
2069
        param  => {title => 'Perl', author => 'Ken'}
2070
    );
2071

            
2072
Insert statement.
2073

            
2074
The following opitons are currently available.
2075

            
update pod
Yuki Kimoto authored on 2011-03-13
2076
=over 4
2077

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

            
2080
Table name.
2081

            
2082
    $dbi->insert(table => 'book');
2083

            
2084
=item C<param>
2085

            
2086
Insert data. This is hash reference.
2087

            
2088
    $dbi->insert(param => {title => 'Perl'});
2089

            
2090
=item C<append>
2091

            
2092
Append statement to last of SQL. This is string.
2093

            
2094
    $dbi->insert(append => 'order by title');
2095

            
2096
=item C<filter>
2097

            
2098
Filter, executed before data is send to database. This is array reference.
2099
Filter value is code reference or
2100
filter name registerd by C<register_filter()>.
2101

            
2102
    # Basic
2103
    $dbi->insert(
2104
        filter => [
2105
            title  => sub { uc $_[0] }
2106
            author => sub { uc $_[0] }
2107
        ]
2108
    );
2109
    
2110
    # At once
2111
    $dbi->insert(
2112
        filter => [
2113
            [qw/title author/]  => sub { uc $_[0] }
2114
        ]
2115
    );
2116
    
2117
    # Filter name
2118
    $dbi->insert(
2119
        filter => [
2120
            title  => 'upper_case',
2121
            author => 'upper_case'
2122
        ]
2123
    );
2124

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

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

            
2129
Get L<DBIx::Custom::Query> object instead of executing SQL.
2130
This is true or false value.
2131

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2138
=back
2139

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

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

            
2144
    $dbi->insert_at(
2145
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2146
        primary_key => 'id',
2147
        where => '5',
2148
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2149
    );
2150

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2155
=over 4
2156

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

            
2159
Primary key. This is constant value or array reference.
2160
    
2161
    # Constant value
2162
    $dbi->insert(primary_key => 'id');
2163

            
2164
    # Array reference
2165
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2166

            
2167
This is used to create parts of insert data.
2168

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

            
2171
Parts of Insert data, create from primary key information.
2172
This is constant value or array reference.
2173

            
2174
    # Constant value
2175
    $dbi->insert(where => 5);
2176

            
2177
    # Array reference
2178
    $dbi->insert(where => [3, 5]);
2179

            
2180
In first examle, the following SQL is created.
2181

            
2182
    insert into book (id, title) values (?, ?);
2183

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2186
=back
2187

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

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

            
2192
Create insert parameter tag.
2193

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2203
    lib / MyModel.pm
2204
        / MyModel / book.pm
2205
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2206

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

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

            
2211
    package MyModel;
2212
    
2213
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2214
    
2215
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2216

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2221
    package MyModel::book;
2222
    
2223
    use base 'MyModel';
2224
    
2225
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2226

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2229
    package MyModel::company;
2230
    
2231
    use base 'MyModel';
2232
    
2233
    1;
2234
    
2235
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2236

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

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

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

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

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

            
2248
Merge paramters.
2249

            
2250
$param:
2251

            
2252
    {key1 => [1, 1], key2 => 2}
2253

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

            
2256
    $dbi->method(
2257
        update_or_insert => sub {
2258
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2259
            
2260
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2261
        },
2262
        find_or_create   => sub {
2263
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2264
            
2265
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2266
        }
2267
    );
2268

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

            
2271
    $dbi->update_or_insert;
2272
    $dbi->find_or_create;
2273

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

            
2276
    $dbi->model('book')->method(
2277
        insert => sub { ... },
2278
        update => sub { ... }
2279
    );
2280
    
2281
    my $model = $dbi->model('book');
2282

            
2283
Set and get a L<DBIx::Custom::Model> object,
2284

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

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

            
2289
Create column clause for myself. The follwoing column clause is created.
2290

            
2291
    book.author as author,
2292
    book.title as title
2293

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2296
    my $dbi = DBIx::Custom->new(
2297
        data_source => "dbi:mysql:database=dbname",
2298
        user => 'ken',
2299
        password => '!LFKD%$&',
2300
        dbi_option => {mysql_enable_utf8 => 1}
2301
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2302

            
2303
Create a new L<DBIx::Custom> object.
2304

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

            
2307
    my $not_exists = $dbi->not_exists;
2308

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2312
=head2 C<register_filter>
2313

            
update pod
Yuki Kimoto authored on 2011-03-13
2314
    $dbi->register_filter(
2315
        # Time::Piece object to database DATE format
2316
        tp_to_date => sub {
2317
            my $tp = shift;
2318
            return $tp->strftime('%Y-%m-%d');
2319
        },
2320
        # database DATE format to Time::Piece object
2321
        date_to_tp => sub {
2322
           my $date = shift;
2323
           return Time::Piece->strptime($date, '%Y-%m-%d');
2324
        }
2325
    );
cleanup
yuki-kimoto authored on 2010-10-17
2326
    
update pod
Yuki Kimoto authored on 2011-03-13
2327
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2328

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2331
    $dbi->register_tag(
2332
        update => sub {
2333
            my @columns = @_;
2334
            
2335
            # Update parameters
2336
            my $s = 'set ';
2337
            $s .= "$_ = ?, " for @columns;
2338
            $s =~ s/, $//;
2339
            
2340
            return [$s, \@columns];
2341
        }
2342
    );
cleanup
yuki-kimoto authored on 2010-10-17
2343

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2367
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2368
        table  => 'book',
2369
        column => ['author', 'title'],
2370
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2371
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2372
    
update pod
Yuki Kimoto authored on 2011-03-12
2373
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2374

            
2375
The following opitons are currently available.
2376

            
2377
=over 4
2378

            
2379
=item C<table>
2380

            
2381
Table name.
2382

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

            
2385
=item C<column>
2386

            
2387
Column clause. This is array reference or constant value.
2388

            
2389
    # Hash refernce
2390
    $dbi->select(column => ['author', 'title']);
2391
    
2392
    # Constant value
2393
    $dbi->select(column => 'author');
2394

            
2395
Default is '*' unless C<column> is specified.
2396

            
2397
    # Default
2398
    $dbi->select(column => '*');
2399

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

            
2402
=over 4
2403

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

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

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

            
2410
If main table is C<book> and joined table is C<company>,
2411
This create the following column clause.
2412

            
2413
    book.author as author
2414
    book.company_id as company_id
2415
    company.id as company__id
2416
    company.name as company__name
2417

            
2418
Columns of main table is consist of only column name,
2419
Columns of joined table is consist of table and column name joined C<__>.
2420

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

            
2424
    # Generally do the following way before using all_column option
2425
    $dbi->include_model('MyModel')->setup_model;
2426

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

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

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

            
2433
=item prepend EXPERIMENTAL
2434

            
2435
You can add before created statement
2436

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

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

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2443
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2444
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2445
    
2446
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2447
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2448
    
update pod
Yuki Kimoto authored on 2011-03-12
2449
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2450
    my $where = $dbi->where(
2451
        clause => ['and', '{= author}', '{like title}'],
2452
        param  => {author => 'Ken', title => '%Perl%'}
2453
    );
update pod
Yuki Kimoto authored on 2011-03-12
2454
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2455

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2456
    # Array refrendce (where clause and parameter)
2457
    $dbi->select(where =>
2458
        [
2459
            ['and', '{= author}', '{like title}'],
2460
            {author => 'Ken', title => '%Perl%'}
2461
        ]
2462
    );
2463
    
update pod
Yuki Kimoto authored on 2011-03-13
2464
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2465

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

            
2468
    $dbi->select(join =>
2469
        [
2470
            'left outer join company on book.company_id = company_id',
2471
            'left outer join location on company.location_id = location.id'
2472
        ]
2473
    );
2474

            
2475
If column cluase or where clause contain table name like "company.name",
2476
needed join clause is used automatically.
2477

            
2478
    $dbi->select(
2479
        table => 'book',
2480
        column => ['company.location_id as company__location_id'],
2481
        where => {'company.name' => 'Orange'},
2482
        join => [
2483
            'left outer join company on book.company_id = company.id',
2484
            'left outer join location on company.location_id = location.id'
2485
        ]
2486
    );
2487

            
2488
In above select, the following SQL is created.
2489

            
2490
    select company.location_id as company__location_id
2491
    from book
2492
      left outer join company on book.company_id = company.id
2493
    where company.name = Orange
2494

            
2495
=item C<append>
2496

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

            
2499
    $dbi->select(append => 'order by title');
2500

            
2501
=item C<filter>
2502

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

            
2507
    # Basic
2508
    $dbi->select(
2509
        filter => [
2510
            title  => sub { uc $_[0] }
2511
            author => sub { uc $_[0] }
2512
        ]
2513
    );
2514
    
2515
    # At once
2516
    $dbi->select(
2517
        filter => [
2518
            [qw/title author/]  => sub { uc $_[0] }
2519
        ]
2520
    );
2521
    
2522
    # Filter name
2523
    $dbi->select(
2524
        filter => [
2525
            title  => 'upper_case',
2526
            author => 'upper_case'
2527
        ]
2528
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2529

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

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

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

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

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

            
2541
    my $sql = $query->sql;
2542

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

            
2545
Specify database data type.
2546

            
2547
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2548
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2549

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

            
2552
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2553

            
update pod
Yuki Kimoto authored on 2011-03-12
2554
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2555

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

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

            
2560
    $dbi->select_at(
2561
        table => 'book',
2562
        primary_key => 'id',
2563
        where => '5'
2564
    );
2565

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2570
=over 4
2571

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2574
Primary key. This is constant value or array reference.
2575
    
2576
    # Constant value
2577
    $dbi->select(primary_key => 'id');
2578

            
2579
    # Array reference
2580
    $dbi->select(primary_key => ['id1', 'id2' ]);
2581

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

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

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

            
2589
    # Constant value
2590
    $dbi->select(where => 5);
2591

            
2592
    # Array reference
2593
    $dbi->select(where => [3, 5]);
2594

            
2595
In first examle, the following SQL is created.
2596

            
2597
    select * from book where id = ?
2598

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2601
=back
2602

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2605
    $dbi->update(
2606
        table  => 'book',
2607
        param  => {title => 'Perl'},
2608
        where  => {id => 4}
2609
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2610

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2615
=over 4
2616

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2619
Table name.
2620

            
2621
    $dbi->update(table => 'book');
2622

            
2623
=item C<param>
2624

            
2625
Update data. This is hash reference.
2626

            
2627
    $dbi->update(param => {title => 'Perl'});
2628

            
2629
=item C<where>
2630

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2631
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2632
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2633
    
2634
    # Hash reference
2635
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2636
    
2637
    # DBIx::Custom::Where object
2638
    my $where = $dbi->where(
2639
        clause => ['and', '{= author}', '{like title}'],
2640
        param  => {author => 'Ken', title => '%Perl%'}
2641
    );
2642
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2643
    
2644
    # Array refrendce (where clause and parameter)
2645
    $dbi->update(where =>
2646
        [
2647
            ['and', '{= author}', '{like title}'],
2648
            {author => 'Ken', title => '%Perl%'}
2649
        ]
2650
    );
update pod
Yuki Kimoto authored on 2011-03-13
2651

            
2652
=item C<append>
2653

            
2654
Append statement to last of SQL. This is string.
2655

            
2656
    $dbi->update(append => 'order by title');
2657

            
2658
=item C<filter>
2659

            
2660
Filter, executed before data is send to database. This is array reference.
2661
Filter value is code reference or
2662
filter name registerd by C<register_filter()>.
2663

            
2664
    # Basic
2665
    $dbi->update(
2666
        filter => [
2667
            title  => sub { uc $_[0] }
2668
            author => sub { uc $_[0] }
2669
        ]
2670
    );
2671
    
2672
    # At once
2673
    $dbi->update(
2674
        filter => [
2675
            [qw/title author/]  => sub { uc $_[0] }
2676
        ]
2677
    );
2678
    
2679
    # Filter name
2680
    $dbi->update(
2681
        filter => [
2682
            title  => 'upper_case',
2683
            author => 'upper_case'
2684
        ]
2685
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2686

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

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

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

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

            
2696
You can check SQL.
2697

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2700
=back
2701

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

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

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

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

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

            
2713
    $dbi->update_at(
2714
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2715
        primary_key => 'id',
2716
        where => '5',
2717
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2718
    );
2719

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2724
=over 4
2725

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

            
2728
Primary key. This is constant value or array reference.
2729
    
2730
    # Constant value
2731
    $dbi->update(primary_key => 'id');
2732

            
2733
    # Array reference
2734
    $dbi->update(primary_key => ['id1', 'id2' ]);
2735

            
2736
This is used to create where clause.
2737

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

            
2740
Where clause, created from primary key information.
2741
This is constant value or array reference.
2742

            
2743
    # Constant value
2744
    $dbi->update(where => 5);
2745

            
2746
    # Array reference
2747
    $dbi->update(where => [3, 5]);
2748

            
2749
In first examle, the following SQL is created.
2750

            
2751
    update book set title = ? where id = ?
2752

            
2753
Place holders are set to 'Perl' and 5.
2754

            
update pod
Yuki Kimoto authored on 2011-03-13
2755
=back
2756

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

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

            
2761
Create update parameter tag.
2762

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2768
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2769
        {title => 'a', age => 2}
2770
        {no_set => 1}
2771
    );
2772

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2777
    my $where = $dbi->where(
2778
        clause => ['and', '{= title}', '{= author}'],
2779
        param => {title => 'Perl', author => 'Ken'}
2780
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2781

            
2782
Create a new L<DBIx::Custom::Where> object.
2783

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2791
=head1 Tags
2792

            
2793
The following tags is available.
2794

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

            
2797
Table tag
2798

            
2799
    {table TABLE}    ->    TABLE
2800

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2803
=head2 C<?>
2804

            
2805
Placeholder tag.
2806

            
2807
    {? NAME}    ->   ?
2808

            
2809
=head2 C<=>
2810

            
2811
Equal tag.
2812

            
2813
    {= NAME}    ->   NAME = ?
2814

            
2815
=head2 C<E<lt>E<gt>>
2816

            
2817
Not equal tag.
2818

            
2819
    {<> NAME}   ->   NAME <> ?
2820

            
2821
=head2 C<E<lt>>
2822

            
2823
Lower than tag
2824

            
2825
    {< NAME}    ->   NAME < ?
2826

            
2827
=head2 C<E<gt>>
2828

            
2829
Greater than tag
2830

            
2831
    {> NAME}    ->   NAME > ?
2832

            
2833
=head2 C<E<gt>=>
2834

            
2835
Greater than or equal tag
2836

            
2837
    {>= NAME}   ->   NAME >= ?
2838

            
2839
=head2 C<E<lt>=>
2840

            
2841
Lower than or equal tag
2842

            
2843
    {<= NAME}   ->   NAME <= ?
2844

            
2845
=head2 C<like>
2846

            
2847
Like tag
2848

            
2849
    {like NAME}   ->   NAME like ?
2850

            
2851
=head2 C<in>
2852

            
2853
In tag.
2854

            
2855
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2856

            
2857
=head2 C<insert_param>
2858

            
2859
Insert parameter tag.
2860

            
2861
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2862

            
2863
=head2 C<update_param>
2864

            
2865
Updata parameter tag.
2866

            
2867
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2868

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

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

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

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

            
2878
C<< <kimoto.yuki at gmail.com> >>
2879

            
2880
L<http://github.com/yuki-kimoto/DBIx-Custom>
2881

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2882
=head1 AUTHOR
2883

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

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

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

            
2890
This program is free software; you can redistribute it and/or modify it
2891
under the same terms as Perl itself.
2892

            
2893
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2894

            
2895