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

            
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
3
our $VERSION = '0.1670';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
843
sub replace {
844
    my ($self, $join, $search, $replace) = @_;
845
    
846
    my @replace_join;
847
    my $is_replaced;
848
    foreach my $j (@$join) {
849
        if ($search eq $j) {
850
            push @replace_join, $replace;
851
            $is_replaced = 1;
852
        }
853
        else {
854
            push @replace_join, $j;
855
        }
856
    }
857
    croak qq{Can't replace "$search" with "$replace"} unless $is_replaced;
858
    
859
    return @replace_join;
860
}
861

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

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

            
868
    # Quote for reserved word
869
    my $q = $self->reserved_word_quote;
packaging one directory
yuki-kimoto authored on 2009-11-16
870
    
cleanup
Yuki Kimoto authored on 2011-03-09
871
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
872
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
873
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
874
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
875
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
876
    
refactoring select
yuki-kimoto authored on 2010-04-28
877
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
878
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
879
    my $tables = ref $table eq 'ARRAY' ? $table
880
               : defined $table ? [$table]
881
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
882
    my $columns   = delete $args{column};
883
    my $where     = delete $args{where} || {};
884
    my $append    = delete $args{append};
885
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
886
    croak qq{"join" must be array reference}
887
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
888
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
889
    my $param = delete $args{param} || {};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
890
    
cleanup
Yuki Kimoto authored on 2011-03-09
891
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
892
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
893
    
cleanup
Yuki Kimoto authored on 2011-01-27
894
    # SQL stack
895
    my @sql;
896
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
897
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
898
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
899
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
900
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
901
        foreach my $column (@$columns) {
902
            unshift @$tables, @{$self->_tables($column)};
903
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
904
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
905
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
906
    }
907
    
908
    # "*" is default
909
    else { push @sql, '*' }
910
    
911
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
912
    push @sql, 'from';
913
    if ($relation) {
914
        my $found = {};
915
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
916
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
917
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
918
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
919
    }
cleanup
Yuki Kimoto authored on 2011-03-30
920
    else {
921
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
922
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
923
    }
924
    pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
925
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
926
    # Main table
927
    croak "Not found table name" unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
928

            
929
    # Add table names in param
930
    unshift @$tables, @{$self->_tables(join(' ', keys %$param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
931
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
932
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
933
    my $w = $self->_where($where);
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
934
    $param = keys %$param ? $self->merge_param($param, $w->param)
935
                         : $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
936
    
937
    # String where
938
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
939
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
940
    # Add table names in where clause
941
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
942
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
943
    # Push join
944
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
945
    
cleanup
Yuki Kimoto authored on 2011-03-09
946
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
947
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
948
    
cleanup
Yuki Kimoto authored on 2011-03-08
949
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
950
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
951
    
cleanup
Yuki Kimoto authored on 2011-01-27
952
    # Append statement
953
    push @sql, $append if $append;
954
    
955
    # SQL
956
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
957
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
958
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
959
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
960
    return $query if $args{query};
961
    
packaging one directory
yuki-kimoto authored on 2009-11-16
962
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
963
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
964
        $query,
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
965
        param  => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
966
        table => $tables,
967
        %args
968
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
969
    
970
    return $result;
971
}
972

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1017
sub setup_model {
1018
    my $self = shift;
1019
    
1020
    $self->each_column(
1021
        sub {
1022
            my ($self, $table, $column, $column_info) = @_;
1023
            
1024
            if (my $model = $self->models->{$table}) {
1025
                push @{$model->columns}, $column;
1026
            }
1027
        }
1028
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1029
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1030
}
1031

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

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

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

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

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

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

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1161
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1162
    my ($self, $param, $opt) = @_;
1163
    
1164
    # Insert parameter tag
1165
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1166
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1167
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1168
    my $q = $self->reserved_word_quote;
1169
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1170
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1171
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1172
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1173
        
1174
        my $c = "$q$column$q";
1175
        $c =~ s/\./$q.$q/;
1176
        
1177
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1178
    }
1179
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1180
    my $clause;
1181
    $clause .= 'set ' unless $opt->{no_set};
1182
    $clause .= join(', ', @params);
1183
    
1184
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1185
}
1186

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

            
1190
    return DBIx::Custom::Where->new(
1191
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1192
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1193
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1194
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1195
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1196
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1197

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1198
sub _bind {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1199
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1200
    
cleanup
Yuki Kimoto authored on 2011-01-12
1201
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1202
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1203
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1204
    # Build bind values
1205
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1206
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1207
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1208
        
1209
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1210
        my $value;
1211
        if(ref $params->{$column} eq 'ARRAY') {
1212
            my $i = $count->{$column} || 0;
1213
            $i += $not_exists->{$column} || 0;
1214
            my $found;
1215
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1216
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1217
                    $not_exists->{$column}++;
1218
                }
1219
                else  {
1220
                    $value = $params->{$column}->[$k];
1221
                    $found = 1;
1222
                    last
1223
                }
1224
            }
1225
            next unless $found;
1226
        }
1227
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1228
        
cleanup
Yuki Kimoto authored on 2011-01-12
1229
        # Filter
1230
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1231
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1232
        # Type
1233
        push @$bind, {
1234
            value => $f ? $f->($value) : $value,
1235
            type => $type->{$column}
1236
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1237
        
1238
        # Count up 
1239
        $count->{$column}++;
1240
    }
1241
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1242
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1243
}
1244

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1245
sub _connect {
1246
    my $self = shift;
1247
    
1248
    # Attributes
1249
    my $data_source = $self->data_source;
1250
    croak qq{"data_source" must be specified to connect()"}
1251
      unless $data_source;
1252
    my $user        = $self->user;
1253
    my $password    = $self->password;
1254
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1255
    
1256
    # Connect
1257
    my $dbh = eval {DBI->connect(
1258
        $data_source,
1259
        $user,
1260
        $password,
1261
        {
1262
            %{$self->default_dbi_option},
1263
            %$dbi_option
1264
        }
1265
    )};
1266
    
1267
    # Connect error
1268
    croak $@ if $@;
1269
    
1270
    return $dbh;
1271
}
1272

            
cleanup
yuki-kimoto authored on 2010-10-17
1273
sub _croak {
1274
    my ($self, $error, $append) = @_;
1275
    $append ||= "";
1276
    
1277
    # Verbose
1278
    if ($Carp::Verbose) { croak $error }
1279
    
1280
    # Not verbose
1281
    else {
1282
        
1283
        # Remove line and module infromation
1284
        my $at_pos = rindex($error, ' at ');
1285
        $error = substr($error, 0, $at_pos);
1286
        $error =~ s/\s+$//;
1287
        
1288
        croak "$error$append";
1289
    }
1290
}
1291

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1292
sub _need_tables {
1293
    my ($self, $tree, $need_tables, $tables) = @_;
1294
    
1295
    foreach my $table (@$tables) {
1296
        
1297
        if ($tree->{$table}) {
1298
            $need_tables->{$table} = 1;
1299
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1300
        }
1301
    }
1302
}
1303

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1304
sub _tables {
1305
    my ($self, $source) = @_;
1306
    
1307
    my $tables = [];
1308
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1309
    my $safety_character = $self->safety_character;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1310
    my $q = $self->reserved_word_quote;
1311
    my $q_re = quotemeta($q);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1312
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1313
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1314
                      : qr/\b([$safety_character]+)\./;
1315
    while ($source =~ /$table_re/g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1316
        push @$tables, $1;
1317
    }
1318
    
1319
    return $tables;
1320
}
1321

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1322
sub _push_join {
1323
    my ($self, $sql, $join, $join_tables) = @_;
1324
    
1325
    return unless @$join;
1326
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1327
    my $q = $self->reserved_word_quote;
1328
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1329
    my $tree = {};
1330
    
1331
    for (my $i = 0; $i < @$join; $i++) {
1332
        
1333
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1334
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1335
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1336
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1337
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1338
            
1339
            my $table1 = $1;
1340
            my $table2 = $2;
1341
            
1342
            croak qq{right side table of "$join_clause" must be uniq}
1343
              if exists $tree->{$table2};
1344
            
1345
            $tree->{$table2}
1346
              = {position => $i, parent => $table1, join => $join_clause};
1347
        }
1348
        else {
1349
            croak qq{join "$join_clause" must be two table name};
1350
        }
1351
    }
1352
    
1353
    my $need_tables = {};
1354
    $self->_need_tables($tree, $need_tables, $join_tables);
1355
    
1356
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1357

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1358
    foreach my $need_table (@need_tables) {
1359
        push @$sql, $tree->{$need_table}{join};
1360
    }
1361
}
cleanup
Yuki Kimoto authored on 2011-03-08
1362

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1363
sub _where {
1364
    my ($self, $where) = @_;
1365
    
1366
    my $w;
1367
    if (ref $where eq 'HASH') {
1368
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1369
        my $q = $self->reserved_word_quote;
1370
        foreach my $column (keys %$where) {
1371
            $column = "$q$column$q";
1372
            $column =~ s/\./$q.$q/;
1373
            push @$clause, "{= $column}" for keys %$where;
1374
        }
1375
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1376
        $w = $self->where(clause => $clause, param => $where);
1377
    }
1378
    elsif (ref $where eq 'DBIx::Custom::Where') {
1379
        $w = $where;
1380
    }
1381
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1382
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1383
             "use \$dbi->select(where => \$dbi->where(clause => " .
1384
             "CLAUSE, param => PARAMETER));";
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1385
        $w = $self->where(
1386
            clause => $where->[0],
1387
            param  => $where->[1]
1388
        );
1389
    }
1390
    
1391
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1392
          qq{or array reference, which contains where clause and paramter}
1393
      unless ref $w eq 'DBIx::Custom::Where';
1394
    
1395
    return $w;
1396
}
1397

            
cleanup
Yuki Kimoto authored on 2011-01-25
1398
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1399
__PACKAGE__->attr(
1400
    dbi_options => sub { {} },
1401
    filter_check  => 1
1402
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1403

            
cleanup
Yuki Kimoto authored on 2011-01-25
1404
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1405
sub default_bind_filter {
1406
    my $self = shift;
1407
    
1408
    if (@_) {
1409
        my $fname = $_[0];
1410
        
1411
        if (@_ && !$fname) {
1412
            $self->{default_out_filter} = undef;
1413
        }
1414
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1415
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1416
              unless exists $self->filters->{$fname};
1417
        
1418
            $self->{default_out_filter} = $self->filters->{$fname};
1419
        }
1420
        return $self;
1421
    }
1422
    
1423
    return $self->{default_out_filter};
1424
}
1425

            
cleanup
Yuki Kimoto authored on 2011-01-25
1426
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1427
sub default_fetch_filter {
1428
    my $self = shift;
1429
    
1430
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1431
        my $fname = $_[0];
1432

            
cleanup
Yuki Kimoto authored on 2011-01-12
1433
        if (@_ && !$fname) {
1434
            $self->{default_in_filter} = undef;
1435
        }
1436
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1437
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1438
              unless exists $self->filters->{$fname};
1439
        
1440
            $self->{default_in_filter} = $self->filters->{$fname};
1441
        }
1442
        
1443
        return $self;
1444
    }
1445
    
many changed
Yuki Kimoto authored on 2011-01-23
1446
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1447
}
1448

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1449
# DEPRECATED!
1450
sub insert_param {
1451
    warn "insert_param is renamed to insert_param_tag."
1452
       . " insert_param is DEPRECATED!";
1453
    return shift->insert_param_tag(@_);
1454
}
1455

            
cleanup
Yuki Kimoto authored on 2011-01-25
1456
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1457
sub register_tag_processor {
1458
    return shift->query_builder->register_tag_processor(@_);
1459
}
1460

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1461
# DEPRECATED!
1462
sub update_param {
1463
    warn "update_param is renamed to update_param_tag."
1464
       . " update_param is DEPRECATED!";
1465
    return shift->update_param_tag(@_);
1466
}
cleanup
Yuki Kimoto authored on 2011-03-08
1467
# DEPRECATED!
1468
sub _push_relation {
1469
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1470
    
1471
    if (keys %{$relation || {}}) {
1472
        push @$sql, $need_where ? 'where' : 'and';
1473
        foreach my $rcolumn (keys %$relation) {
1474
            my $table1 = (split (/\./, $rcolumn))[0];
1475
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1476
            push @$tables, ($table1, $table2);
1477
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1478
        }
1479
    }
1480
    pop @$sql if $sql->[-1] eq 'and';    
1481
}
1482

            
1483
# DEPRECATED!
1484
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1485
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1486
    
1487
    if (keys %{$relation || {}}) {
1488
        foreach my $rcolumn (keys %$relation) {
1489
            my $table1 = (split (/\./, $rcolumn))[0];
1490
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1491
            my $table1_exists;
1492
            my $table2_exists;
1493
            foreach my $table (@$tables) {
1494
                $table1_exists = 1 if $table eq $table1;
1495
                $table2_exists = 1 if $table eq $table2;
1496
            }
1497
            unshift @$tables, $table1 unless $table1_exists;
1498
            unshift @$tables, $table2 unless $table2_exists;
1499
        }
1500
    }
1501
}
1502

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1505
=head1 NAME
1506

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

            
1509
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1510

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1511
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1512
    
1513
    # Connect
1514
    my $dbi = DBIx::Custom->connect(
1515
        data_source => "dbi:mysql:database=dbname",
1516
        user => 'ken',
1517
        password => '!LFKD%$&',
1518
        dbi_option => {mysql_enable_utf8 => 1}
1519
    );
cleanup
yuki-kimoto authored on 2010-08-05
1520

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1521
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1522
    $dbi->insert(
1523
        table  => 'book',
1524
        param  => {title => 'Perl', author => 'Ken'}
1525
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1526
    
1527
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1528
    $dbi->update(
1529
        table  => 'book', 
1530
        param  => {title => 'Perl', author => 'Ken'}, 
1531
        where  => {id => 5},
1532
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1533
    
1534
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1535
    $dbi->delete(
1536
        table  => 'book',
1537
        where  => {author => 'Ken'},
1538
    );
cleanup
yuki-kimoto authored on 2010-08-05
1539

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1546
    # Select, more complex
1547
    my $result = $dbi->select(
1548
        table  => 'book',
1549
        column => [
1550
            'book.author as book__author',
1551
            'company.name as company__name'
1552
        ],
1553
        where  => {'book.author' => 'Ken'},
1554
        join => ['left outer join company on book.company_id = company.id'],
1555
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1556
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1557
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1558
    # Fetch
1559
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1560
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1561
    }
1562
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1563
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1564
    while (my $row = $result->fetch_hash) {
1565
        
1566
    }
1567
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1568
    # Execute SQL with parameter.
1569
    $dbi->execute(
1570
        "select id from book where {= author} and {like title}",
1571
        param  => {author => 'ken', title => '%Perl%'}
1572
    );
1573
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1574
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1575

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

            
1578
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1579

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1584
There are many basic methods to execute various queries.
1585
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1586
C<delete_all()>, C<select()>,
1587
C<insert_at()>, C<update_at()>, 
1588
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1589

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1590
=item *
1591

            
1592
Filter when data is send or receive.
1593

            
1594
=item *
1595

            
1596
Data filtering system
1597

            
1598
=item *
1599

            
1600
Model support.
1601

            
1602
=item *
1603

            
1604
Generate where clause dinamically.
1605

            
1606
=item *
1607

            
1608
Generate join clause dinamically.
1609

            
1610
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1611

            
1612
=head1 GUIDE
1613

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

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

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

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

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

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

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

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

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

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

            
1637
=head2 C<default_dbi_option>
1638

            
1639
    my $default_dbi_option = $dbi->default_dbi_option;
1640
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1641

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1645
    {
1646
        RaiseError => 1,
1647
        PrintError => 0,
1648
        AutoCommit => 1,
1649
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1650

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

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

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

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

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

            
1663
    my $models = $dbi->models;
1664
    $dbi       = $dbi->models(\%models);
1665

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1668
=head2 C<password>
1669

            
1670
    my $password = $dbi->password;
1671
    $dbi         = $dbi->password('lkj&le`@s');
1672

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

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

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

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

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

            
1684
     my reserved_word_quote = $dbi->reserved_word_quote;
1685
     $dbi                   = $dbi->reserved_word_quote('"');
1686

            
1687
Quote for reserved word, default to empty string.
1688

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1706
    my $user = $dbi->user;
1707
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1708

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1719
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1720
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1721
        'issue_date' => {
1722
            out => 'tp_to_date',
1723
            in  => 'date_to_tp',
1724
            end => 'tp_to_displaydate'
1725
        },
1726
        'write_date' => {
1727
            out => 'tp_to_date',
1728
            in  => 'date_to_tp',
1729
            end => 'tp_to_displaydate'
1730
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1731
    );
1732

            
update pod
Yuki Kimoto authored on 2011-03-13
1733
Apply filter to columns.
1734
C<out> filter is executed before data is send to database.
1735
C<in> filter is executed after a row is fetch.
1736
C<end> filter is execute after C<in> filter is executed.
1737

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1740
       PETTERN         EXAMPLE
1741
    1. Column        : author
1742
    2. Table.Column  : book.author
1743
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1744

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

            
1748
You can set multiple filters at once.
1749

            
1750
    $dbi->apply_filter(
1751
        'book',
1752
        [qw/issue_date write_date/] => {
1753
            out => 'tp_to_date',
1754
            in  => 'date_to_tp',
1755
            end => 'tp_to_displaydate'
1756
        }
1757
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1758

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1761
    my $dbi = DBIx::Custom->connect(
1762
        data_source => "dbi:mysql:database=dbname",
1763
        user => 'ken',
1764
        password => '!LFKD%$&',
1765
        dbi_option => {mysql_enable_utf8 => 1}
1766
    );
1767

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1776
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1777
        table => 'book',
1778
        primary_key => 'id',
1779
        join => [
1780
            'inner join company on book.comparny_id = company.id'
1781
        ],
1782
        filter => [
1783
            publish_date => {
1784
                out => 'tp_to_date',
1785
                in => 'date_to_tp',
1786
                end => 'tp_to_displaydate'
1787
            }
1788
        ]
1789
    );
1790

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

            
1794
   $dbi->model('book')->select(...);
1795

            
cleanup
yuki-kimoto authored on 2010-10-17
1796
=head2 C<create_query>
1797
    
1798
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1799
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1800
    );
update document
yuki-kimoto authored on 2009-11-19
1801

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

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

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

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

            
1812
    my $dbh = $dbi->dbh;
1813
    $dbi    = $dbi->dbh($dbh);
1814

            
1815
Get and set database handle of L<DBI>.
1816

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

            
1819
=head2 C<each_column>
1820

            
1821
    $dbi->each_column(
1822
        sub {
1823
            my ($dbi, $table, $column, $column_info) = @_;
1824
            
1825
            my $type = $column_info->{TYPE_NAME};
1826
            
1827
            if ($type eq 'DATE') {
1828
                # ...
1829
            }
1830
        }
1831
    );
1832

            
1833
Iterate all column informations of all table from database.
1834
Argument is callback when one column is found.
1835
Callback receive four arguments, dbi object, table name,
1836
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1837

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1840
    my $result = $dbi->execute(
1841
        "select * from book where {= title} and {like author}",
1842
        param => {title => 'Perl', author => '%Ken%'}
1843
    );
1844

            
1845
Execute SQL, containing tags.
1846
Return value is L<DBIx::Custom::Result> in select statement, or
1847
the count of affected rows in insert, update, delete statement.
1848

            
1849
Tag is turned into the statement containing place holder
1850
before SQL is executed.
1851

            
1852
    select * from where title = ? and author like ?;
1853

            
1854
See also L<Tags/Tags>.
1855

            
1856
The following opitons are currently available.
1857

            
1858
=over 4
1859

            
1860
=item C<filter>
1861

            
1862
Filter, executed before data is send to database. This is array reference.
1863
Filter value is code reference or
1864
filter name registerd by C<register_filter()>.
1865

            
1866
    # Basic
1867
    $dbi->execute(
1868
        $sql,
1869
        filter => [
1870
            title  => sub { uc $_[0] }
1871
            author => sub { uc $_[0] }
1872
        ]
1873
    );
1874
    
1875
    # At once
1876
    $dbi->execute(
1877
        $sql,
1878
        filter => [
1879
            [qw/title author/]  => sub { uc $_[0] }
1880
        ]
1881
    );
1882
    
1883
    # Filter name
1884
    $dbi->execute(
1885
        $sql,
1886
        filter => [
1887
            title  => 'upper_case',
1888
            author => 'upper_case'
1889
        ]
1890
    );
1891

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

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

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

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

            
1900
Delete statement.
1901

            
1902
The following opitons are currently available.
1903

            
update pod
Yuki Kimoto authored on 2011-03-13
1904
=over 4
1905

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

            
1908
Table name.
1909

            
1910
    $dbi->delete(table => 'book');
1911

            
1912
=item C<where>
1913

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1914
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1915
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1916
    
1917
    # Hash reference
1918
    $dbi->delete(where => {title => 'Perl'});
1919
    
1920
    # DBIx::Custom::Where object
1921
    my $where = $dbi->where(
1922
        clause => ['and', '{= author}', '{like title}'],
1923
        param  => {author => 'Ken', title => '%Perl%'}
1924
    );
1925
    $dbi->delete(where => $where);
1926

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1927
    # Array refrendce (where clause and parameter)
1928
    $dbi->delete(where =>
1929
        [
1930
            ['and', '{= author}', '{like title}'],
1931
            {author => 'Ken', title => '%Perl%'}
1932
        ]
1933
    );
1934
    
update pod
Yuki Kimoto authored on 2011-03-13
1935
=item C<append>
1936

            
1937
Append statement to last of SQL. This is string.
1938

            
1939
    $dbi->delete(append => 'order by title');
1940

            
1941
=item C<filter>
1942

            
1943
Filter, executed before data is send to database. This is array reference.
1944
Filter value is code reference or
1945
filter name registerd by C<register_filter()>.
1946

            
1947
    # Basic
1948
    $dbi->delete(
1949
        filter => [
1950
            title  => sub { uc $_[0] }
1951
            author => sub { uc $_[0] }
1952
        ]
1953
    );
1954
    
1955
    # At once
1956
    $dbi->delete(
1957
        filter => [
1958
            [qw/title author/]  => sub { uc $_[0] }
1959
        ]
1960
    );
1961
    
1962
    # Filter name
1963
    $dbi->delete(
1964
        filter => [
1965
            title  => 'upper_case',
1966
            author => 'upper_case'
1967
        ]
1968
    );
1969

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

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

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

            
1976
Create column clause. The follwoing column clause is created.
1977

            
1978
    book.author as book__author,
1979
    book.title as book__title
1980

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

            
1983
Get L<DBIx::Custom::Query> object instead of executing SQL.
1984
This is true or false value.
1985

            
1986
    my $query = $dbi->delete(query => 1);
1987

            
1988
You can check SQL.
1989

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1992
=back
1993

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

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

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

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

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

            
2005
    $dbi->delete_at(
2006
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2007
        primary_key => 'id',
2008
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2009
    );
2010

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2019
Primary key. This is constant value or array reference.
2020
    
2021
    # Constant value
2022
    $dbi->delete(primary_key => 'id');
2023

            
2024
    # Array reference
2025
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2026

            
2027
This is used to create where clause.
2028

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

            
2031
Where clause, created from primary key information.
2032
This is constant value or array reference.
2033

            
2034
    # Constant value
2035
    $dbi->delete(where => 5);
2036

            
2037
    # Array reference
2038
    $dbi->delete(where => [3, 5]);
2039

            
2040
In first examle, the following SQL is created.
2041

            
2042
    delete from book where id = ?;
2043

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2046
=back
2047

            
cleanup
yuki-kimoto authored on 2010-10-17
2048
=head2 C<insert>
2049

            
update pod
Yuki Kimoto authored on 2011-03-13
2050
    $dbi->insert(
2051
        table  => 'book', 
2052
        param  => {title => 'Perl', author => 'Ken'}
2053
    );
2054

            
2055
Insert statement.
2056

            
2057
The following opitons are currently available.
2058

            
update pod
Yuki Kimoto authored on 2011-03-13
2059
=over 4
2060

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

            
2063
Table name.
2064

            
2065
    $dbi->insert(table => 'book');
2066

            
2067
=item C<param>
2068

            
2069
Insert data. This is hash reference.
2070

            
2071
    $dbi->insert(param => {title => 'Perl'});
2072

            
2073
=item C<append>
2074

            
2075
Append statement to last of SQL. This is string.
2076

            
2077
    $dbi->insert(append => 'order by title');
2078

            
2079
=item C<filter>
2080

            
2081
Filter, executed before data is send to database. This is array reference.
2082
Filter value is code reference or
2083
filter name registerd by C<register_filter()>.
2084

            
2085
    # Basic
2086
    $dbi->insert(
2087
        filter => [
2088
            title  => sub { uc $_[0] }
2089
            author => sub { uc $_[0] }
2090
        ]
2091
    );
2092
    
2093
    # At once
2094
    $dbi->insert(
2095
        filter => [
2096
            [qw/title author/]  => sub { uc $_[0] }
2097
        ]
2098
    );
2099
    
2100
    # Filter name
2101
    $dbi->insert(
2102
        filter => [
2103
            title  => 'upper_case',
2104
            author => 'upper_case'
2105
        ]
2106
    );
2107

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

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

            
2112
Get L<DBIx::Custom::Query> object instead of executing SQL.
2113
This is true or false value.
2114

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2121
=back
2122

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

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

            
2127
    $dbi->insert_at(
2128
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2129
        primary_key => 'id',
2130
        where => '5',
2131
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2132
    );
2133

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

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

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

            
2142
Primary key. This is constant value or array reference.
2143
    
2144
    # Constant value
2145
    $dbi->insert(primary_key => 'id');
2146

            
2147
    # Array reference
2148
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2149

            
2150
This is used to create parts of insert data.
2151

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

            
2154
Parts of Insert data, create from primary key information.
2155
This is constant value or array reference.
2156

            
2157
    # Constant value
2158
    $dbi->insert(where => 5);
2159

            
2160
    # Array reference
2161
    $dbi->insert(where => [3, 5]);
2162

            
2163
In first examle, the following SQL is created.
2164

            
2165
    insert into book (id, title) values (?, ?);
2166

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2169
=back
2170

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

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

            
2175
Create insert parameter tag.
2176

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2186
    lib / MyModel.pm
2187
        / MyModel / book.pm
2188
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2189

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

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

            
2194
    package MyModel;
2195
    
2196
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2197
    
2198
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2199

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2204
    package MyModel::book;
2205
    
2206
    use base 'MyModel';
2207
    
2208
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2209

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2212
    package MyModel::company;
2213
    
2214
    use base 'MyModel';
2215
    
2216
    1;
2217
    
2218
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2219

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

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

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

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

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

            
2231
Merge paramters.
2232

            
2233
$param:
2234

            
2235
    {key1 => [1, 1], key2 => 2}
2236

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

            
2239
    $dbi->method(
2240
        update_or_insert => sub {
2241
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2242
            
2243
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2244
        },
2245
        find_or_create   => sub {
2246
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2247
            
2248
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2249
        }
2250
    );
2251

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

            
2254
    $dbi->update_or_insert;
2255
    $dbi->find_or_create;
2256

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

            
2259
    $dbi->model('book')->method(
2260
        insert => sub { ... },
2261
        update => sub { ... }
2262
    );
2263
    
2264
    my $model = $dbi->model('book');
2265

            
2266
Set and get a L<DBIx::Custom::Model> object,
2267

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

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

            
2272
Create column clause for myself. The follwoing column clause is created.
2273

            
2274
    book.author as author,
2275
    book.title as title
2276

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2279
    my $dbi = DBIx::Custom->new(
2280
        data_source => "dbi:mysql:database=dbname",
2281
        user => 'ken',
2282
        password => '!LFKD%$&',
2283
        dbi_option => {mysql_enable_utf8 => 1}
2284
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2285

            
2286
Create a new L<DBIx::Custom> object.
2287

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

            
2290
    my $not_exists = $dbi->not_exists;
2291

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2295
=head2 C<register_filter>
2296

            
update pod
Yuki Kimoto authored on 2011-03-13
2297
    $dbi->register_filter(
2298
        # Time::Piece object to database DATE format
2299
        tp_to_date => sub {
2300
            my $tp = shift;
2301
            return $tp->strftime('%Y-%m-%d');
2302
        },
2303
        # database DATE format to Time::Piece object
2304
        date_to_tp => sub {
2305
           my $date = shift;
2306
           return Time::Piece->strptime($date, '%Y-%m-%d');
2307
        }
2308
    );
cleanup
yuki-kimoto authored on 2010-10-17
2309
    
update pod
Yuki Kimoto authored on 2011-03-13
2310
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2311

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2314
    $dbi->register_tag(
2315
        update => sub {
2316
            my @columns = @_;
2317
            
2318
            # Update parameters
2319
            my $s = 'set ';
2320
            $s .= "$_ = ?, " for @columns;
2321
            $s =~ s/, $//;
2322
            
2323
            return [$s, \@columns];
2324
        }
2325
    );
cleanup
yuki-kimoto authored on 2010-10-17
2326

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2348
=head2 C<replace> EXPERIMENTAL
2349
    
2350
    my $join = [
2351
        'left outer join table2 on table1.key1 = table2.key1',
2352
        'left outer join table3 on table2.key3 = table3.key3'
2353
    ];
2354
    $join = $dbi->replace(
2355
        $join,
2356
        'left outer join table2 on table1.key1 = table2.key1',
2357
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2358
          'as table2 on table1.key1 = table2.key1'
2359
    );
2360

            
2361
Replace join clauses if match the expression.
2362

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

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

            
2373
The following opitons are currently available.
2374

            
2375
=over 4
2376

            
2377
=item C<table>
2378

            
2379
Table name.
2380

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

            
2383
=item C<column>
2384

            
2385
Column clause. This is array reference or constant value.
2386

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

            
2393
Default is '*' unless C<column> is specified.
2394

            
2395
    # Default
2396
    $dbi->select(column => '*');
2397

            
2398
=item C<where>
2399

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2400
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2401
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2402
    
2403
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2404
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2405
    
update pod
Yuki Kimoto authored on 2011-03-12
2406
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2407
    my $where = $dbi->where(
2408
        clause => ['and', '{= author}', '{like title}'],
2409
        param  => {author => 'Ken', title => '%Perl%'}
2410
    );
update pod
Yuki Kimoto authored on 2011-03-12
2411
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2412

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2413
    # Array refrendce (where clause and parameter)
2414
    $dbi->select(where =>
2415
        [
2416
            ['and', '{= author}', '{like title}'],
2417
            {author => 'Ken', title => '%Perl%'}
2418
        ]
2419
    );
2420
    
update pod
Yuki Kimoto authored on 2011-03-13
2421
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2422

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

            
2425
    $dbi->select(join =>
2426
        [
2427
            'left outer join company on book.company_id = company_id',
2428
            'left outer join location on company.location_id = location.id'
2429
        ]
2430
    );
2431

            
2432
If column cluase or where clause contain table name like "company.name",
2433
needed join clause is used automatically.
2434

            
2435
    $dbi->select(
2436
        table => 'book',
2437
        column => ['company.location_id as company__location_id'],
2438
        where => {'company.name' => 'Orange'},
2439
        join => [
2440
            'left outer join company on book.company_id = company.id',
2441
            'left outer join location on company.location_id = location.id'
2442
        ]
2443
    );
2444

            
2445
In above select, the following SQL is created.
2446

            
2447
    select company.location_id as company__location_id
2448
    from book
2449
      left outer join company on book.company_id = company.id
2450
    where company.name = Orange
2451

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2452
=item C<param> EXPERIMETNAL
2453

            
2454
Parameter shown before where clause.
2455
    
2456
    $dbi->select(
2457
        table => 'table1',
2458
        column => 'table1.key1 as table1_key1, key2, key3',
2459
        where   => {'table1.key2' => 3},
2460
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2461
                  ' as table2 on table1.key1 = table2.key1'],
2462
        param => {'table2.key3' => 5}
2463
    );
2464

            
2465
For example, if you want to contain tag in join clause, 
2466
you can pass parameter by C<param> option.
2467

            
update pod
Yuki Kimoto authored on 2011-03-12
2468
=item C<append>
2469

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

            
2472
    $dbi->select(append => 'order by title');
2473

            
2474
=item C<filter>
2475

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

            
2480
    # Basic
2481
    $dbi->select(
2482
        filter => [
2483
            title  => sub { uc $_[0] }
2484
            author => sub { uc $_[0] }
2485
        ]
2486
    );
2487
    
2488
    # At once
2489
    $dbi->select(
2490
        filter => [
2491
            [qw/title author/]  => sub { uc $_[0] }
2492
        ]
2493
    );
2494
    
2495
    # Filter name
2496
    $dbi->select(
2497
        filter => [
2498
            title  => 'upper_case',
2499
            author => 'upper_case'
2500
        ]
2501
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2502

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

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

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

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

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

            
2514
    my $sql = $query->sql;
2515

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

            
2518
Specify database data type.
2519

            
2520
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2521
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2522

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

            
2525
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2526

            
update pod
Yuki Kimoto authored on 2011-03-12
2527
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2528

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

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

            
2533
    $dbi->select_at(
2534
        table => 'book',
2535
        primary_key => 'id',
2536
        where => '5'
2537
    );
2538

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2543
=over 4
2544

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2547
Primary key. This is constant value or array reference.
2548
    
2549
    # Constant value
2550
    $dbi->select(primary_key => 'id');
2551

            
2552
    # Array reference
2553
    $dbi->select(primary_key => ['id1', 'id2' ]);
2554

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

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

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

            
2562
    # Constant value
2563
    $dbi->select(where => 5);
2564

            
2565
    # Array reference
2566
    $dbi->select(where => [3, 5]);
2567

            
2568
In first examle, the following SQL is created.
2569

            
2570
    select * from book where id = ?
2571

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2574
=back
2575

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2578
    $dbi->update(
2579
        table  => 'book',
2580
        param  => {title => 'Perl'},
2581
        where  => {id => 4}
2582
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2583

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2588
=over 4
2589

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2592
Table name.
2593

            
2594
    $dbi->update(table => 'book');
2595

            
2596
=item C<param>
2597

            
2598
Update data. This is hash reference.
2599

            
2600
    $dbi->update(param => {title => 'Perl'});
2601

            
2602
=item C<where>
2603

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2604
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2605
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2606
    
2607
    # Hash reference
2608
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2609
    
2610
    # DBIx::Custom::Where object
2611
    my $where = $dbi->where(
2612
        clause => ['and', '{= author}', '{like title}'],
2613
        param  => {author => 'Ken', title => '%Perl%'}
2614
    );
2615
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2616
    
2617
    # Array refrendce (where clause and parameter)
2618
    $dbi->update(where =>
2619
        [
2620
            ['and', '{= author}', '{like title}'],
2621
            {author => 'Ken', title => '%Perl%'}
2622
        ]
2623
    );
update pod
Yuki Kimoto authored on 2011-03-13
2624

            
2625
=item C<append>
2626

            
2627
Append statement to last of SQL. This is string.
2628

            
2629
    $dbi->update(append => 'order by title');
2630

            
2631
=item C<filter>
2632

            
2633
Filter, executed before data is send to database. This is array reference.
2634
Filter value is code reference or
2635
filter name registerd by C<register_filter()>.
2636

            
2637
    # Basic
2638
    $dbi->update(
2639
        filter => [
2640
            title  => sub { uc $_[0] }
2641
            author => sub { uc $_[0] }
2642
        ]
2643
    );
2644
    
2645
    # At once
2646
    $dbi->update(
2647
        filter => [
2648
            [qw/title author/]  => sub { uc $_[0] }
2649
        ]
2650
    );
2651
    
2652
    # Filter name
2653
    $dbi->update(
2654
        filter => [
2655
            title  => 'upper_case',
2656
            author => 'upper_case'
2657
        ]
2658
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2659

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

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

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

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

            
2669
You can check SQL.
2670

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2673
=back
2674

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

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

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

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

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

            
2686
    $dbi->update_at(
2687
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2688
        primary_key => 'id',
2689
        where => '5',
2690
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2691
    );
2692

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2697
=over 4
2698

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

            
2701
Primary key. This is constant value or array reference.
2702
    
2703
    # Constant value
2704
    $dbi->update(primary_key => 'id');
2705

            
2706
    # Array reference
2707
    $dbi->update(primary_key => ['id1', 'id2' ]);
2708

            
2709
This is used to create where clause.
2710

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

            
2713
Where clause, created from primary key information.
2714
This is constant value or array reference.
2715

            
2716
    # Constant value
2717
    $dbi->update(where => 5);
2718

            
2719
    # Array reference
2720
    $dbi->update(where => [3, 5]);
2721

            
2722
In first examle, the following SQL is created.
2723

            
2724
    update book set title = ? where id = ?
2725

            
2726
Place holders are set to 'Perl' and 5.
2727

            
update pod
Yuki Kimoto authored on 2011-03-13
2728
=back
2729

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

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

            
2734
Create update parameter tag.
2735

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2741
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2742
        {title => 'a', age => 2}
2743
        {no_set => 1}
2744
    );
2745

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2750
    my $where = $dbi->where(
2751
        clause => ['and', '{= title}', '{= author}'],
2752
        param => {title => 'Perl', author => 'Ken'}
2753
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2754

            
2755
Create a new L<DBIx::Custom::Where> object.
2756

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2764
=head1 Tags
2765

            
2766
The following tags is available.
2767

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

            
2770
Table tag
2771

            
2772
    {table TABLE}    ->    TABLE
2773

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2776
=head2 C<?>
2777

            
2778
Placeholder tag.
2779

            
2780
    {? NAME}    ->   ?
2781

            
2782
=head2 C<=>
2783

            
2784
Equal tag.
2785

            
2786
    {= NAME}    ->   NAME = ?
2787

            
2788
=head2 C<E<lt>E<gt>>
2789

            
2790
Not equal tag.
2791

            
2792
    {<> NAME}   ->   NAME <> ?
2793

            
2794
=head2 C<E<lt>>
2795

            
2796
Lower than tag
2797

            
2798
    {< NAME}    ->   NAME < ?
2799

            
2800
=head2 C<E<gt>>
2801

            
2802
Greater than tag
2803

            
2804
    {> NAME}    ->   NAME > ?
2805

            
2806
=head2 C<E<gt>=>
2807

            
2808
Greater than or equal tag
2809

            
2810
    {>= NAME}   ->   NAME >= ?
2811

            
2812
=head2 C<E<lt>=>
2813

            
2814
Lower than or equal tag
2815

            
2816
    {<= NAME}   ->   NAME <= ?
2817

            
2818
=head2 C<like>
2819

            
2820
Like tag
2821

            
2822
    {like NAME}   ->   NAME like ?
2823

            
2824
=head2 C<in>
2825

            
2826
In tag.
2827

            
2828
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2829

            
2830
=head2 C<insert_param>
2831

            
2832
Insert parameter tag.
2833

            
2834
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2835

            
2836
=head2 C<update_param>
2837

            
2838
Updata parameter tag.
2839

            
2840
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2841

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

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

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

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

            
2851
C<< <kimoto.yuki at gmail.com> >>
2852

            
2853
L<http://github.com/yuki-kimoto/DBIx-Custom>
2854

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2855
=head1 AUTHOR
2856

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

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

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

            
2863
This program is free software; you can redistribute it and/or modify it
2864
under the same terms as Perl itself.
2865

            
2866
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2867

            
2868