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

            
updatedd pod
Yuki Kimoto authored on 2011-06-12
3
our $VERSION = '0.1690';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
5

            
updatedd pod
Yuki Kimoto authored on 2011-06-12
6
use Object::Simple -base;
many change
yuki-kimoto authored on 2010-02-11
7

            
packaging one directory
yuki-kimoto authored on 2009-11-16
8
use Carp 'croak';
9
use DBI;
10
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
11
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
12
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
13
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
14
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
15
use DBIx::Custom::Tag;
cleanup
Yuki Kimoto authored on 2011-04-25
16
use DBIx::Custom::Util qw/_array_to_hash _subname/;
improved debug message
Yuki Kimoto authored on 2011-05-23
17
use Encode qw/encode encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
18

            
added environment variable D...
Yuki Kimoto authored on 2011-04-02
19
use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
improved debug message
Yuki Kimoto authored on 2011-05-23
20
use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
added environment variable D...
Yuki Kimoto authored on 2011-04-02
21

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

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

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

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

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

            
added DBIx::Custom result_fi...
Yuki Kimoto authored on 2011-06-12
82
sub apply_filter { shift->_apply_filter(@_) }
83

            
84
sub _apply_filter {
many changed
Yuki Kimoto authored on 2011-01-23
85
    my ($self, $table, @cinfos) = @_;
86

            
87
    # Initialize filters
cleanup
Yuki Kimoto authored on 2011-01-12
88
    $self->{filter} ||= {};
many changed
Yuki Kimoto authored on 2011-01-23
89
    $self->{filter}{out} ||= {};
90
    $self->{filter}{in} ||= {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
91
    $self->{filter}{end} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-22
92
    
cleanup
Yuki Kimoto authored on 2011-04-02
93
    # Usage
many changed
Yuki Kimoto authored on 2011-01-23
94
    my $usage = "Usage: \$dbi->apply_filter(" .
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
95
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
96
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
cleanup
Yuki Kimoto authored on 2011-04-02
97
    
98
    # Apply filter
many changed
Yuki Kimoto authored on 2011-01-23
99
    for (my $i = 0; $i < @cinfos; $i += 2) {
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
100
        
many changed
Yuki Kimoto authored on 2011-01-23
101
        # Column
102
        my $column = $cinfos[$i];
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
103
        if (ref $column eq 'ARRAY') {
104
            foreach my $c (@$column) {
105
                push @cinfos, $c, $cinfos[$i + 1];
106
            }
107
            next;
108
        }
109
        
cleanup
Yuki Kimoto authored on 2011-04-02
110
        # Filter infomation
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
111
        my $finfo = $cinfos[$i + 1] || {};
cleanup
Yuki Kimoto authored on 2011-04-25
112
        croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
113
          unless  ref $finfo eq 'HASH';
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
114
        foreach my $ftype (keys %$finfo) {
cleanup
Yuki Kimoto authored on 2011-04-25
115
            croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
116
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
many changed
Yuki Kimoto authored on 2011-01-23
117
        }
118
        
cleanup
Yuki Kimoto authored on 2011-04-02
119
        # Set filters
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
120
        foreach my $way (qw/in out end/) {
cleanup
Yuki Kimoto authored on 2011-04-02
121
        
122
            # Filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
123
            my $filter = $finfo->{$way};
cleanup
Yuki Kimoto authored on 2010-12-22
124
            
cleanup
Yuki Kimoto authored on 2011-04-02
125
            # Filter state
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
126
            my $state = !exists $finfo->{$way} ? 'not_exists'
127
                      : !defined $filter        ? 'not_defined'
128
                      : ref $filter eq 'CODE'   ? 'code'
129
                      : 'name';
130
            
cleanup
Yuki Kimoto authored on 2011-04-02
131
            # Filter is not exists
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
132
            next if $state eq 'not_exists';
133
            
cleanup
Yuki Kimoto authored on 2011-04-02
134
            # Check filter name
cleanup
Yuki Kimoto authored on 2011-04-25
135
            croak qq{Filter "$filter" is not registered } . _subname
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
136
              if  $state eq 'name'
137
               && ! exists $self->filters->{$filter};
138
            
cleanup
Yuki Kimoto authored on 2011-04-02
139
            # Set filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
140
            my $f = $state eq 'not_defined' ? undef
141
                  : $state eq 'code'        ? $filter
142
                  : $self->filters->{$filter};
143
            $self->{filter}{$way}{$table}{$column} = $f;
144
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
145
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
146
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
147
    }
148
    
many changed
Yuki Kimoto authored on 2011-01-23
149
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
150
}
151

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
152
sub assign_param {
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
153
    my ($self, $param) = @_;
154
    
155
    # Create set tag
156
    my @params;
157
    my $safety = $self->safety_character;
158
    my $q = $self->reserved_word_quote;
159
    foreach my $column (keys %$param) {
160
        croak qq{"$column" is not safety column name } . _subname
161
          unless $column =~ /^[$safety\.]+$/;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
162
        my $column_quote = "$q$column$q";
163
        $column_quote =~ s/\./$q.$q/;
164
        push @params, "$column_quote = :$column";
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
165
    }
166
    my $tag = join(', ', @params);
167
    
168
    return $tag;
169
}
170

            
added EXPERIMENTAL col metho...
Yuki Kimoto authored on 2011-06-08
171
sub col {
172
    my ($self, $table, $columns) = @_;
173
    
174
    # Reserved word quote
175
    my $q = $self->reserved_word_quote;
176
    
177
    # Column clause
178
    my @column;
179
    $columns ||= [];
180
    push @column, "$q$table$q.$q$_$q as $q${table}.$_$q" for @$columns;
181
    
182
    return join (', ', @column);
183
}
184

            
cleanup
Yuki Kimoto authored on 2011-03-21
185
sub column {
186
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
187
    
cleanup
Yuki Kimoto authored on 2011-04-02
188
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
189
    my $q = $self->reserved_word_quote;
190
    
cleanup
Yuki Kimoto authored on 2011-04-02
191
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
192
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
193
    $columns ||= [];
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
194
    push @column, "$q$table$q.$q$_$q as $q${table}__$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
195
    
196
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
197
}
198

            
packaging one directory
yuki-kimoto authored on 2009-11-16
199
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
200
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
201
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
202
    # Connect
203
    $self->dbh;
update document
yuki-kimoto authored on 2010-01-30
204
    
packaging one directory
yuki-kimoto authored on 2009-11-16
205
    return $self;
206
}
207

            
cleanup
yuki-kimoto authored on 2010-10-17
208
sub create_query {
209
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
210
    
cleanup
yuki-kimoto authored on 2010-10-17
211
    # Cache
212
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
213
    
cleanup
Yuki Kimoto authored on 2011-04-02
214
    # Query
cleanup
yuki-kimoto authored on 2010-10-17
215
    my $query;
cleanup
Yuki Kimoto authored on 2011-04-02
216
    
217
    # Get cached query
cleanup
yuki-kimoto authored on 2010-10-17
218
    if ($cache) {
219
        
220
        # Get query
221
        my $q = $self->cache_method->($self, $source);
222
        
223
        # Create query
add table tag
Yuki Kimoto authored on 2011-02-09
224
        if ($q) {
225
            $query = DBIx::Custom::Query->new($q);
226
            $query->filters($self->filters);
227
        }
cleanup
yuki-kimoto authored on 2010-10-17
228
    }
229
    
cleanup
Yuki Kimoto authored on 2011-04-02
230
    # Create query
cleanup
yuki-kimoto authored on 2010-10-17
231
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
232

            
cleanup
yuki-kimoto authored on 2010-10-17
233
        # Create query
cleanup
Yuki Kimoto authored on 2011-04-02
234
        my $builder = $self->query_builder;
cleanup
yuki-kimoto authored on 2010-10-17
235
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
236

            
cleanup
Yuki Kimoto authored on 2011-04-02
237
        # Remove reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
238
        if (my $q = $self->reserved_word_quote) {
cleanup
Yuki Kimoto authored on 2011-04-02
239
            $_ =~ s/$q//g for @{$query->columns}
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
240
        }
241

            
cleanup
Yuki Kimoto authored on 2011-04-02
242
        # Save query to cache
243
        $self->cache_method->(
244
            $self, $source,
245
            {
246
                sql     => $query->sql, 
247
                columns => $query->columns,
248
                tables  => $query->tables
249
            }
250
        ) if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
251
    }
252
    
cleanup
yuki-kimoto authored on 2010-10-17
253
    # Prepare statement handle
254
    my $sth;
255
    eval { $sth = $self->dbh->prepare($query->{sql})};
improved error messages
Yuki Kimoto authored on 2011-04-18
256
    
257
    if ($@) {
258
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
259
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
260
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
261
    
cleanup
yuki-kimoto authored on 2010-10-17
262
    # Set statement handle
263
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
264
    
cleanup
Yuki Kimoto authored on 2011-02-09
265
    # Set filters
266
    $query->filters($self->filters);
267
    
cleanup
yuki-kimoto authored on 2010-10-17
268
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
269
}
270

            
update pod
Yuki Kimoto authored on 2011-03-13
271
sub dbh {
272
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
273
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
274
    # Set
275
    if (@_) {
276
        $self->{dbh} = $_[0];
277
        
278
        return $self;
279
    }
280
    
281
    # Get
282
    else {
283
        # From Connction manager
284
        if (my $connector = $self->connector) {
cleanup
Yuki Kimoto authored on 2011-04-25
285
            croak "connector must have dbh() method " . _subname
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
286
              unless ref $connector && $connector->can('dbh');
287
              
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
288
            $self->{dbh} = $connector->dbh;
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
289
        }
290
        
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
291
        # Connect
292
        $self->{dbh} ||= $self->_connect;
293
        
294
        # Quote
295
        unless ($self->reserved_word_quote) {
296
            my $driver = $self->{dbh}->{Driver}->{Name};
297
            my $quote = $driver eq 'mysql' ? '`' : '"';
298
            $self->reserved_word_quote($quote);
299
        }
300

            
301
        return $self->{dbh};
update pod
Yuki Kimoto authored on 2011-03-13
302
    }
303
}
304

            
cleanup
Yuki Kimoto authored on 2011-03-21
305
our %DELETE_ARGS
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
306
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all where_param/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
307

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
311
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
312
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
313
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
314
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
315
    }
316
    
317
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
318
    my $table = $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
319
    croak qq{"table" option must be specified. } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
320
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
321
    my $where            = delete $args{where} || {};
322
    my $append           = delete $args{append};
323
    my $allow_delete_all = delete $args{allow_delete_all};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
324
    my $where_param      = delete $args{where_param} || {};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
325
    my $id = delete $args{id};
326
    my $primary_key = delete $args{primary_key};
327
    croak "update method primary_key option " .
328
          "must be specified when id is specified " . _subname
329
      if defined $id && !defined $primary_key;
330
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
331
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
332
    # Where
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
333
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
334
    my $where_clause = '';
335
    if (ref $where) {
336
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
337
        $where_param = keys %$where_param
338
                     ? $self->merge_param($where_param, $where->param)
339
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
340
        
341
        # String where
342
        $where_clause = $where->to_string;
343
    }
344
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
345
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
346
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
347

            
cleanup
Yuki Kimoto authored on 2011-04-02
348
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
349
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
350
    my $q = $self->reserved_word_quote;
351
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
352
    push @sql, $append if $append;
353
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
354
    
355
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
356
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-06-09
357
        $sql,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
358
        param => $where_param,
cleanup
Yuki Kimoto authored on 2011-03-21
359
        table => $table,
360
        %args
361
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
362
}
363

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

            
added helper method
yuki-kimoto authored on 2010-10-17
366
sub DESTROY { }
367

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
368
sub create_model {
369
    my $self = shift;
370
    
cleanup
Yuki Kimoto authored on 2011-04-02
371
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
372
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
373
    $args->{dbi} = $self;
374
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
375
    my $model_name  = delete $args->{name};
376
    my $model_table = delete $args->{table};
377
    $model_name ||= $model_table;
378
    
cleanup
Yuki Kimoto authored on 2011-04-02
379
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
380
    my $model = $model_class->new($args);
381
    $model->name($model_name) unless $model->name;
382
    $model->table($model_table) unless $model->table;
383
    
384
    # Apply filter
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
385
    my $filter = ref $model->filter eq 'HASH'
386
               ? [%{$model->filter}]
387
               : $model->filter;
388
    $self->apply_filter($model->table, @$filter);
added DBIx::Custom result_fi...
Yuki Kimoto authored on 2011-06-12
389
    my $result_filter = ref $model->result_filter eq 'HASH'
390
               ? [%{$model->result_filter}]
391
               : $model->result_filter;
392
    for (my $i = 1; $i < @$result_filter; $i += 2) {
393
        $result_filter->[$i] = {in => $result_filter->[$i]};
394
    }
395
    $self->apply_filter($model->table, @$result_filter);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
396
    
cleanup
Yuki Kimoto authored on 2011-04-02
397
    # Associate table with model
cleanup
Yuki Kimoto authored on 2011-04-25
398
    croak "Table name is duplicated " . _subname
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
399
      if exists $self->{_model_from}->{$model->table};
400
    $self->{_model_from}->{$model->table} = $model->name;
401

            
402
    # Table alias
403
    $self->{_table_alias} ||= {};
404
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
405
    
406
    # Set model
407
    $self->model($model->name, $model);
408
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
409
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
410
}
411

            
412
sub each_column {
413
    my ($self, $cb) = @_;
414
    
415
    # Iterate all tables
416
    my $sth_tables = $self->dbh->table_info;
417
    while (my $table_info = $sth_tables->fetchrow_hashref) {
418
        
419
        # Table
420
        my $table = $table_info->{TABLE_NAME};
421
        
422
        # Iterate all columns
423
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
424
        while (my $column_info = $sth_columns->fetchrow_hashref) {
425
            my $column = $column_info->{COLUMN_NAME};
426
            $self->$cb($table, $column, $column_info);
427
        }
428
    }
429
}
430

            
cleanup
Yuki Kimoto authored on 2011-04-02
431
our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
432

            
433
sub execute {
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
434
    my $self = shift;
435
    my $query = shift;
436
    my $param;
437
    $param = shift if @_ % 2;
438
    my %args = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
439
    
cleanup
Yuki Kimoto authored on 2011-04-02
440
    # Arguments
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
441
    my $p = delete $args{param} || {};
442
    $param ||= $p;
cleanup
Yuki Kimoto authored on 2011-04-02
443
    my $tables = delete $args{table} || [];
444
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
445
    my $filter = delete $args{filter};
cleanup
Yuki Kimoto authored on 2011-04-25
446
    $filter = _array_to_hash($filter);
cleanup
Yuki Kimoto authored on 2011-04-02
447
    my $type = delete $args{type};
cleanup
Yuki Kimoto authored on 2011-04-25
448
    $type = _array_to_hash($type);
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
449
    my $type_rule_off = delete $args{type_rule_off};
cleanup
Yuki Kimoto authored on 2011-06-09
450
    my $query_return = delete $args{query};
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
451
    
cleanup
Yuki Kimoto authored on 2011-03-09
452
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
453
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
454
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
455
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
456
    }
457
    
cleanup
Yuki Kimoto authored on 2011-04-02
458
    # Create query
459
    $query = $self->create_query($query) unless ref $query;
cleanup
Yuki Kimoto authored on 2011-06-09
460
    return $query if $query_return;
cleanup
Yuki Kimoto authored on 2011-04-02
461
    $filter ||= $query->filter;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
462
    
cleanup
Yuki Kimoto authored on 2011-04-02
463
    # Tables
464
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
465
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
466
    $tables = $self->_remove_duplicate_table($tables, $main_table);
467
    if (my $q = $self->reserved_word_quote) {
468
        $_ =~ s/$q//g for @$tables;
469
    }
cleanup
Yuki Kimoto authored on 2011-04-02
470
    
471
    # Table alias
cleanup
Yuki Kimoto authored on 2011-04-02
472
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
473
        
cleanup
Yuki Kimoto authored on 2011-04-02
474
        # No need
475
        next unless my $alias = $self->{_table_alias}->{$table};
476
        $self->{filter} ||= {};
477
        next if $self->{filter}{out}{$table};
478
        
479
        # Filter
480
        $self->{filter}{out} ||= {};
481
        $self->{filter}{in}  ||= {};
482
        $self->{filter}{end} ||= {};
483
        
484
        # Create alias filter
485
        foreach my $type (qw/out in end/) {
486
            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};
487
            foreach my $filter_name (@filter_names) {
488
                my $filter_name_alias = $filter_name;
489
                $filter_name_alias =~ s/^$alias\./$table\./;
490
                $filter_name_alias =~ s/^${alias}__/${table}__/; 
491
                $self->{filter}{$type}{$table}{$filter_name_alias}
492
                  = $self->{filter}{$type}{$alias}{$filter_name}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
493
            }
494
        }
495
    }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
496

            
497
    # Type rule
498
    my $applied_filter = {};
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
499
    unless ($type_rule_off) {
500
        foreach my $name (keys %$param) {
501
            my $table;
502
            my $column;
503
            if ($name =~ /(?:(.+)\.)?(.+)/) {
504
                $table = $1;
505
                $column = $2;
506
            }
507
            $table ||= $main_table;
508
            
509
            my $into = $self->{_into} || {};
510
            if (defined $table && $into->{$table} &&
511
                (my $rule = $into->{$table}->{$column}))
512
            {
513
                $applied_filter->{$column} = $rule;
514
                $applied_filter->{"$table.$column"} = $rule;
515
            }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
516
        }
517
    }
cleanup
Yuki Kimoto authored on 2011-04-02
518
    
519
    # Applied filter
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
520
    foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
521
        $applied_filter = {
522
            %$applied_filter,
cleanup
Yuki Kimoto authored on 2011-01-12
523
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
524
        }
525
    }
cleanup
Yuki Kimoto authored on 2011-04-02
526
    $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
527
    
cleanup
Yuki Kimoto authored on 2011-04-02
528
    # Replace filter name to code
529
    foreach my $column (keys %$filter) {
530
        my $name = $filter->{$column};
531
        if (!defined $name) {
532
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
533
        }
cleanup
Yuki Kimoto authored on 2011-04-02
534
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
535
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
536
            unless exists $self->filters->{$name};
537
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
538
        }
539
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
540
    
cleanup
Yuki Kimoto authored on 2011-04-02
541
    # Create bind values
542
    my $bind = $self->_create_bind_values(
543
        $param,
544
        $query->columns,
545
        $filter,
546
        $type
547
    );
cleanup
yuki-kimoto authored on 2010-10-17
548
    
549
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
550
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
551
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
552
    eval {
553
        for (my $i = 0; $i < @$bind; $i++) {
cleanup
Yuki Kimoto authored on 2011-04-02
554
            my $type = $bind->[$i]->{type};
555
            $sth->bind_param($i + 1, $bind->[$i]->{value}, $type ? $type : ());
cleanup
Yuki Kimoto authored on 2011-03-21
556
        }
557
        $affected = $sth->execute;
558
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
559
    
560
    if ($@) {
561
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
562
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
563
    }
cleanup
yuki-kimoto authored on 2010-10-17
564
    
improved debug message
Yuki Kimoto authored on 2011-05-23
565
    # DEBUG message
566
    if (DEBUG) {
567
        print STDERR "SQL:\n" . $query->sql . "\n";
568
        my @output;
569
        foreach my $b (@$bind) {
570
            my $value = $b->{value};
571
            $value = 'undef' unless defined $value;
572
            $value = encode(DEBUG_ENCODING(), $value)
573
              if utf8::is_utf8($value);
574
            push @output, $value;
575
        }
576
        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
577
    }
added environment variable D...
Yuki Kimoto authored on 2011-04-02
578
    
cleanup
Yuki Kimoto authored on 2011-04-02
579
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
580
    if ($sth->{NUM_OF_FIELDS}) {
581
        
cleanup
Yuki Kimoto authored on 2011-04-02
582
        # Filter
583
        my $filter = {};
584
        $filter->{in}  = {};
585
        $filter->{end} = {};
added DBIx::Custom result_fi...
Yuki Kimoto authored on 2011-06-12
586
        push @$tables, $main_table if $main_table;
cleanup
Yuki Kimoto authored on 2011-01-12
587
        foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
588
            foreach my $way (qw/in end/) {
589
                $filter->{$way} = {
590
                    %{$filter->{$way}},
591
                    %{$self->{filter}{$way}{$table} || {}}
592
                };
593
            }
cleanup
Yuki Kimoto authored on 2011-01-12
594
        }
595
        
596
        # Result
597
        my $result = $self->result_class->new(
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
598
            sth => $sth,
599
            filters => $self->filters,
cleanup
Yuki Kimoto authored on 2011-01-12
600
            default_filter => $self->{default_in_filter},
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
601
            filter => $filter->{in} || {},
602
            end_filter => $filter->{end} || {},
603
            type_rule => $self->type_rule,
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
604
            type_rule_off => $type_rule_off
cleanup
yuki-kimoto authored on 2010-10-17
605
        );
606

            
607
        return $result;
608
    }
cleanup
Yuki Kimoto authored on 2011-04-02
609
    
610
    # Not select statement
611
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
612
}
613

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
614
our %INSERT_ARGS = map { $_ => 1 } @COMMON_ARGS, qw/param/;
update pod
Yuki Kimoto authored on 2011-03-13
615

            
cleanup
yuki-kimoto authored on 2010-10-17
616
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
617
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
618
    
cleanup
yuki-kimoto authored on 2010-10-17
619
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
620
    my $param;
621
    $param = shift if @_ % 2;
622
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
623
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
624
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
625
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
626
    my $p = delete $args{param} || {};
627
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
628
    my $append = delete $args{append} || '';
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
629
    my $id = delete $args{id};
630
    my $primary_key = delete $args{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
631
    croak "insert method primary_key option " .
added tests
Yuki Kimoto authored on 2011-06-08
632
          "must be specified when id is specified " . _subname
633
      if defined $id && !defined $primary_key;
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
634
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
635

            
636
    # Check arguments
637
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
638
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
639
          unless $INSERT_ARGS{$name};
640
    }
641

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
642
    # Merge parameter
643
    if ($id) {
cleanup
Yuki Kimoto authored on 2011-06-08
644
        my $id_param = $self->_create_param_from_id($id, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
645
        $param = $self->merge_param($id_param, $param);
646
    }
647

            
cleanup
Yuki Kimoto authored on 2011-04-02
648
    # Reserved word quote
649
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
650
    
cleanup
Yuki Kimoto authored on 2011-04-02
651
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
652
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
653
    push @sql, "insert into $q$table$q " . $self->insert_param($param);
cleanup
Yuki Kimoto authored on 2011-01-27
654
    push @sql, $append if $append;
655
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
656
    
657
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
658
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-06-09
659
        $sql,
cleanup
Yuki Kimoto authored on 2011-04-02
660
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
661
        table => $table,
662
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
663
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
664
}
665

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
666
sub insert_param {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
667
    my ($self, $param) = @_;
668
    
cleanup
Yuki Kimoto authored on 2011-04-02
669
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
670
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
671
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
672
    my @columns;
673
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
674
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
675
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
676
          unless $column =~ /^[$safety\.]+$/;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
677
        my $column_quote = "$q$column$q";
678
        $column_quote =~ s/\./$q.$q/;
679
        push @columns, $column_quote;
680
        push @placeholders, ":$column";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
681
    }
682
    
cleanup
Yuki Kimoto authored on 2011-04-02
683
    return '(' . join(', ', @columns) . ') ' . 'values ' .
684
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
685
}
686

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
687
sub include_model {
688
    my ($self, $name_space, $model_infos) = @_;
689
    
cleanup
Yuki Kimoto authored on 2011-04-02
690
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
691
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
692
    
693
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
694
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
695

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
696
        # Load name space module
cleanup
Yuki Kimoto authored on 2011-04-25
697
        croak qq{"$name_space" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
698
          if $name_space =~ /[^\w:]/;
699
        eval "use $name_space";
cleanup
Yuki Kimoto authored on 2011-04-25
700
        croak qq{Name space module "$name_space.pm" is needed. $@ }
701
            . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
702
          if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
703
        
704
        # Search model modules
705
        my $path = $INC{"$name_space.pm"};
706
        $path =~ s/\.pm$//;
707
        opendir my $dh, $path
cleanup
Yuki Kimoto authored on 2011-04-25
708
          or croak qq{Can't open directory "$path": $! } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
709
        $model_infos = [];
710
        while (my $module = readdir $dh) {
711
            push @$model_infos, $module
712
              if $module =~ s/\.pm$//;
713
        }
714
        close $dh;
715
    }
716
    
cleanup
Yuki Kimoto authored on 2011-04-02
717
    # Include models
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
718
    foreach my $model_info (@$model_infos) {
719
        
cleanup
Yuki Kimoto authored on 2011-04-02
720
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
721
        my $model_class;
722
        my $model_name;
723
        my $model_table;
724
        if (ref $model_info eq 'HASH') {
725
            $model_class = $model_info->{class};
726
            $model_name  = $model_info->{name};
727
            $model_table = $model_info->{table};
728
            
729
            $model_name  ||= $model_class;
730
            $model_table ||= $model_name;
731
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
732
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
733
        my $mclass = "${name_space}::$model_class";
cleanup
Yuki Kimoto authored on 2011-04-25
734
        croak qq{"$mclass" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
735
          if $mclass =~ /[^\w:]/;
736
        unless ($mclass->can('isa')) {
737
            eval "use $mclass";
cleanup
Yuki Kimoto authored on 2011-04-25
738
            croak "$@ " . _subname if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
739
        }
740
        
cleanup
Yuki Kimoto authored on 2011-04-02
741
        # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
742
        my $args = {};
743
        $args->{model_class} = $mclass if $mclass;
744
        $args->{name}        = $model_name if $model_name;
745
        $args->{table}       = $model_table if $model_table;
746
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
747
    }
748
    
749
    return $self;
750
}
751

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
752
sub merge_param {
753
    my ($self, @params) = @_;
754
    
cleanup
Yuki Kimoto authored on 2011-04-02
755
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
756
    my $merge = {};
757
    foreach my $param (@params) {
758
        foreach my $column (keys %$param) {
759
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
760
            
761
            if (exists $merge->{$column}) {
762
                $merge->{$column} = [$merge->{$column}]
763
                  unless ref $merge->{$column} eq 'ARRAY';
764
                push @{$merge->{$column}},
765
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
766
            }
767
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
768
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
769
            }
770
        }
771
    }
772
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
773
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
774
}
775

            
cleanup
Yuki Kimoto authored on 2011-03-21
776
sub method {
777
    my $self = shift;
778
    
cleanup
Yuki Kimoto authored on 2011-04-02
779
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
780
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
781
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
782
    
783
    return $self;
784
}
785

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
786
sub model {
787
    my ($self, $name, $model) = @_;
788
    
cleanup
Yuki Kimoto authored on 2011-04-02
789
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
790
    if ($model) {
791
        $self->models->{$name} = $model;
792
        return $self;
793
    }
794
    
795
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
796
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
797
      unless $self->models->{$name};
798
    
cleanup
Yuki Kimoto authored on 2011-04-02
799
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
800
    return $self->models->{$name};
801
}
802

            
cleanup
Yuki Kimoto authored on 2011-03-21
803
sub mycolumn {
804
    my ($self, $table, $columns) = @_;
805
    
cleanup
Yuki Kimoto authored on 2011-04-02
806
    # Create column clause
807
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
808
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
809
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
810
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
811
    
812
    return join (', ', @column);
813
}
814

            
added dbi_options attribute
kimoto authored on 2010-12-20
815
sub new {
816
    my $self = shift->SUPER::new(@_);
817
    
cleanup
Yuki Kimoto authored on 2011-04-02
818
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
819
    my @attrs = keys %$self;
820
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
821
        croak qq{"$attr" is wrong name } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
822
          unless $self->can($attr);
823
    }
cleanup
Yuki Kimoto authored on 2011-04-02
824
    
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
825
    # DEPRECATED!
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
826
    $self->query_builder->{tags} = {
cleanup
Yuki Kimoto authored on 2011-01-25
827
        '?'     => \&DBIx::Custom::Tag::placeholder,
828
        '='     => \&DBIx::Custom::Tag::equal,
829
        '<>'    => \&DBIx::Custom::Tag::not_equal,
830
        '>'     => \&DBIx::Custom::Tag::greater_than,
831
        '<'     => \&DBIx::Custom::Tag::lower_than,
832
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
833
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
834
        'like'  => \&DBIx::Custom::Tag::like,
835
        'in'    => \&DBIx::Custom::Tag::in,
836
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
837
        'update_param' => \&DBIx::Custom::Tag::update_param
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
838
    };
added dbi_options attribute
kimoto authored on 2010-12-20
839
    
840
    return $self;
841
}
842

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

            
cleanup
yuki-kimoto authored on 2010-10-17
845
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
846
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
847
    
848
    # Register filter
849
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
850
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
851
    
cleanup
Yuki Kimoto authored on 2011-04-02
852
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
853
}
packaging one directory
yuki-kimoto authored on 2009-11-16
854

            
cleanup
Yuki Kimoto authored on 2011-03-21
855
our %SELECT_ARGS
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
856
  = map { $_ => 1 } @COMMON_ARGS,
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
857
                    qw/column where relation join param where_param wrap
858
                       prefix/;
refactoring select
yuki-kimoto authored on 2010-04-28
859

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
863
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
864
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
865
    my $tables = ref $table eq 'ARRAY' ? $table
866
               : defined $table ? [$table]
867
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
868
    my $columns   = delete $args{column};
869
    my $where     = delete $args{where} || {};
870
    my $append    = delete $args{append};
871
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
872
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
873
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
874
    my $relation = delete $args{relation};
added warnings
Yuki Kimoto authored on 2011-06-07
875
    warn "select() relation option is DEPRECATED! use join option instead"
876
      if $relation;
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
877
    my $param = delete $args{param} || {}; # DEPRECATED!
added warnings
Yuki Kimoto authored on 2011-06-07
878
    warn "select() param option is DEPRECATED! use where_param option instead"
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
879
      if keys %$param;
880
    my $where_param = delete $args{where_param} || $param || {};
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
881
    my $wrap = delete $args{wrap};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
882
    my $id = delete $args{id};
883
    my $primary_key = delete $args{primary_key};
884
    croak "update method primary_key option " .
885
          "must be specified when id is specified " . _subname
886
      if defined $id && !defined $primary_key;
887
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
888
    my $prefix = delete $args{prefix};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
889
    
cleanup
Yuki Kimoto authored on 2011-04-02
890
    # Check arguments
891
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
892
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
893
          unless $SELECT_ARGS{$name};
894
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
895
    
cleanup
Yuki Kimoto authored on 2011-03-09
896
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
897
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
898
    
cleanup
Yuki Kimoto authored on 2011-04-02
899
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
900
    my @sql;
901
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
902
    
- select() column option can...
Yuki Kimoto authored on 2011-06-08
903
    # Reserved word quote
904
    my $q = $self->reserved_word_quote;
905
    
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
906
    # Prefix
907
    push @sql, $prefix if defined $prefix;
908
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
909
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
910
    if ($columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-07
911
        $columns = [$columns] unless ref $columns eq 'ARRAY';
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
912
        foreach my $column (@$columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-08
913
            if (ref $column eq 'HASH') {
914
                $column = $self->col(%$column) if ref $column eq 'HASH';
915
            }
916
            elsif (ref $column eq 'ARRAY') {
917
                croak "Format must be [COLUMN, as => ALIAS] " . _subname
918
                  unless @$column == 3 && $column->[1] eq 'as';
919
                $column = join(' ', $column->[0], 'as', $q . $column->[2] . $q);
920
            }
cleanup
Yuki Kimoto authored on 2011-04-02
921
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
922
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
923
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
924
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
925
    }
926
    else { push @sql, '*' }
927
    
928
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
929
    push @sql, 'from';
930
    if ($relation) {
931
        my $found = {};
932
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
933
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
934
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
935
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
936
    }
cleanup
Yuki Kimoto authored on 2011-03-30
937
    else {
938
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
939
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
940
    }
941
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
942
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
943
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
944

            
cleanup
Yuki Kimoto authored on 2011-04-02
945
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
946
    unshift @$tables,
947
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
948
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
949
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
950
    my $where_clause = '';
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
951
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
cleanup
Yuki Kimoto authored on 2011-04-25
952
    if (ref $where) {
953
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
954
        $where_param = keys %$where_param
955
                     ? $self->merge_param($where_param, $where->param)
956
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
957
        
958
        # String where
959
        $where_clause = $where->to_string;
960
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
961
    elsif ($where) { $where_clause = "where $where" }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
962
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
963
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
964
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
965
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
966
    # Push join
967
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
968
    
cleanup
Yuki Kimoto authored on 2011-03-09
969
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
970
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
971
    
cleanup
Yuki Kimoto authored on 2011-03-08
972
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
973
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
974
    
cleanup
Yuki Kimoto authored on 2011-04-02
975
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
976
    push @sql, $append if $append;
977
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
978
    # Wrap
979
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
980
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
981
          unless ref $wrap eq 'ARRAY';
982
        unshift @sql, $wrap->[0];
983
        push @sql, $wrap->[1];
984
    }
985
    
cleanup
Yuki Kimoto authored on 2011-01-27
986
    # SQL
987
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
988
    
989
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
990
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-06-09
991
        $sql,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
992
        param => $where_param, 
cleanup
Yuki Kimoto authored on 2011-03-21
993
        table => $tables,
994
        %args
995
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
996
    
997
    return $result;
998
}
999

            
added EXPERIMETNAL separator...
Yuki Kimoto authored on 2011-06-13
1000
sub separator {
1001
    my $self = shift;
1002
    
1003
    if (@_) {
1004
        my $separator = $_[0] || '';
1005
        croak qq{Separator must be "." or "__" or "-" } . _subname
1006
          unless $separator eq '.' || $separator eq '__'
1007
              || $separator eq '-';
1008
        
1009
        $self->{separator} = $separator;
1010
    
1011
        return $self;
1012
    }
1013
    return $self->{separator} ||= '.';
1014
}
1015

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

            
simplify type_rule
Yuki Kimoto authored on 2011-06-10
1031
sub available_data_type {
1032
    my $self = shift;
1033
    
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1034
    my $data_types = '';
simplify type_rule
Yuki Kimoto authored on 2011-06-10
1035
    foreach my $i (-1000 .. 1000) {
1036
         my $type_info = $self->dbh->type_info($i);
1037
         my $data_type = $type_info->{DATA_TYPE};
1038
         my $type_name = $type_info->{TYPE_NAME};
1039
         $data_types .= "$data_type ($type_name)\n"
1040
           if defined $data_type;
1041
    }
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1042
    return "Data Type maybe equal to Type Name" unless $data_types;
1043
    $data_types = "Data Type (Type name)\n" . $data_types;
simplify type_rule
Yuki Kimoto authored on 2011-06-10
1044
    return $data_types;
1045
}
1046

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1047
sub type_rule {
1048
    my $self = shift;
1049
    
1050
    if (@_) {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1051
        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1052
        
1053
        # Into
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1054
        $type_rule->{into} = _array_to_hash($type_rule->{into});
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1055
        $self->{type_rule} = $type_rule;
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
1056
        $self->{_into} ||= {};
1057
        $self->each_column(sub {
1058
            my ($dbi, $table, $column, $column_info) = @_;
1059
            
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1060
            my $type_name = $column_info->{TYPE_NAME};
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1061
            if ($type_rule->{into} &&
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1062
                (my $filter = $type_rule->{into}->{$type_name}))
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
1063
            {
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1064
                return unless exists $type_rule->{into}->{$type_name};
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1065
                if  (defined $filter && ref $filter ne 'CODE') 
1066
                {
1067
                    my $fname = $filter;
1068
                    croak qq{Filter "$fname" is not registered" } . _subname
1069
                      unless exists $self->filters->{$fname};
1070
                    
1071
                    $filter = $self->filters->{$fname};
1072
                }
1073

            
1074
                $self->{_into}{$table}{$column} = $filter;
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
1075
            }
1076
        });
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1077
        
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1078

            
1079
        # From
1080
        $type_rule->{from} = _array_to_hash($type_rule->{from});
1081
        foreach my $data_type (keys %{$type_rule->{from} || {}}) {
1082
            my $fname = $type_rule->{from}{$data_type};
1083
            if (defined $fname && ref $fname ne 'CODE') {
1084
                croak qq{Filter "$fname" is not registered" } . _subname
1085
                  unless exists $self->filters->{$fname};
1086
                
1087
                $type_rule->{from}{$data_type} = $self->filters->{$fname};
1088
            }
1089
        }
1090
        
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1091
        return $self;
1092
    }
1093
    
1094
    return $self->{type_rule} || {};
1095
}
1096

            
cleanup
Yuki Kimoto authored on 2011-03-21
1097
our %UPDATE_ARGS
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1098
  = map { $_ => 1 } @COMMON_ARGS, qw/param where allow_update_all where_param/;
cleanup
yuki-kimoto authored on 2010-10-17
1099

            
1100
sub update {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1101
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1102

            
cleanup
yuki-kimoto authored on 2010-10-17
1103
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1104
    my $param;
1105
    $param = shift if @_ % 2;
1106
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
1107
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
1108
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
1109
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1110
    my $p = delete $args{param} || {};
1111
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
1112
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1113
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
1114
    my $append           = delete $args{append} || '';
1115
    my $allow_update_all = delete $args{allow_update_all};
cleanup
Yuki Kimoto authored on 2011-06-08
1116
    my $id = delete $args{id};
1117
    my $primary_key = delete $args{primary_key};
1118
    croak "update method primary_key option " .
1119
          "must be specified when id is specified " . _subname
1120
      if defined $id && !defined $primary_key;
1121
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
version 0.0901
yuki-kimoto authored on 2009-12-17
1122
    
cleanup
Yuki Kimoto authored on 2011-04-02
1123
    # Check argument names
1124
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1125
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1126
          unless $UPDATE_ARGS{$name};
1127
    }
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1128

            
cleanup
yuki-kimoto authored on 2010-10-17
1129
    # Update clause
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1130
    my $update_clause = $self->update_param($param);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1131

            
1132
    # Where
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1133
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1134
    my $where_clause = '';
1135
    if (ref $where) {
1136
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1137
        $where_param = keys %$where_param
1138
                     ? $self->merge_param($where_param, $where->param)
1139
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1140
        
1141
        # String where
1142
        $where_clause = $where->to_string;
1143
    }
1144
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1145
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1146
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1147
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1148
    # Merge param
1149
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1150
    
cleanup
Yuki Kimoto authored on 2011-04-02
1151
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1152
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1153
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
1154
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1155
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1156
    
cleanup
Yuki Kimoto authored on 2011-01-27
1157
    # SQL
1158
    my $sql = join(' ', @sql);
1159
    
cleanup
yuki-kimoto authored on 2010-10-17
1160
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1161
    my $ret_val = $self->execute(
cleanup
Yuki Kimoto authored on 2011-06-09
1162
        $sql,
cleanup
Yuki Kimoto authored on 2011-03-21
1163
        param  => $param, 
1164
        table => $table,
1165
        %args
1166
    );
cleanup
yuki-kimoto authored on 2010-10-17
1167
    
1168
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1169
}
1170

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1173
sub update_param {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1174
    my ($self, $param, $opt) = @_;
1175
    
cleanup
Yuki Kimoto authored on 2011-04-02
1176
    # Create update parameter tag
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1177
    my $tag = $self->assign_param($param);
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1178
    $tag = "set $tag" unless $opt->{no_set};
1179

            
cleanup
Yuki Kimoto authored on 2011-04-02
1180
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1181
}
1182

            
cleanup
Yuki Kimoto authored on 2011-01-25
1183
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1184
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1185
    
1186
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1187
    return DBIx::Custom::Where->new(
1188
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1189
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1190
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1191
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1192
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1193
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1194

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

            
cleanup
Yuki Kimoto authored on 2011-06-08
1240
sub _create_param_from_id {
1241
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1242
    
cleanup
Yuki Kimoto authored on 2011-06-08
1243
    # Create parameter
1244
    my $param = {};
1245
    if ($id) {
1246
        $id = [$id] unless ref $id;
1247
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1248
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1249
          unless !ref $id || ref $id eq 'ARRAY';
1250
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1251
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1252
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1253
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1254
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1255
        }
1256
    }
1257
    
cleanup
Yuki Kimoto authored on 2011-06-08
1258
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1259
}
1260

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1261
sub _connect {
1262
    my $self = shift;
1263
    
1264
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1265
    my $dsn = $self->data_source;
fixed bug that data_source D...
Yuki Kimoto authored on 2011-06-13
1266
    warn "data_source is DEPRECATED! use dsn instead\n"
1267
      if $dsn;
added warnings
Yuki Kimoto authored on 2011-06-07
1268
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1269
    croak qq{"dsn" must be specified } . _subname
1270
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1271
    my $user        = $self->user;
1272
    my $password    = $self->password;
1273
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1274
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1275
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1276
    
1277
    # Connect
1278
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1279
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1280
        $user,
1281
        $password,
1282
        {
1283
            %{$self->default_dbi_option},
1284
            %$dbi_option
1285
        }
1286
    )};
1287
    
1288
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1289
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1290
    
1291
    return $dbh;
1292
}
1293

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

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

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1326
sub _push_join {
1327
    my ($self, $sql, $join, $join_tables) = @_;
1328
    
cleanup
Yuki Kimoto authored on 2011-04-02
1329
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1330
    return unless @$join;
1331
    
cleanup
Yuki Kimoto authored on 2011-04-02
1332
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1333
    my $tree = {};
cleanup
Yuki Kimoto authored on 2011-04-02
1334
    my $q = $self->reserved_word_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1335
    for (my $i = 0; $i < @$join; $i++) {
1336
        
cleanup
Yuki Kimoto authored on 2011-04-02
1337
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1338
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1339
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1340
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1341
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1342
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1343
            my $table1 = $1;
1344
            my $table2 = $2;
cleanup
Yuki Kimoto authored on 2011-04-25
1345
            croak qq{right side table of "$join_clause" must be unique }
1346
                . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1347
              if exists $tree->{$table2};
1348
            $tree->{$table2}
1349
              = {position => $i, parent => $table1, join => $join_clause};
1350
        }
1351
        else {
improved error message
Yuki Kimoto authored on 2011-06-13
1352
            croak qq{join clause must have two table name after "on" keyword. } .
1353
                  qq{"$join_clause" is passed }  . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1354
        }
1355
    }
1356
    
cleanup
Yuki Kimoto authored on 2011-04-02
1357
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1358
    my $need_tables = {};
1359
    $self->_need_tables($tree, $need_tables, $join_tables);
1360
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1361
    
1362
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1363
    foreach my $need_table (@need_tables) {
1364
        push @$sql, $tree->{$need_table}{join};
1365
    }
1366
}
cleanup
Yuki Kimoto authored on 2011-03-08
1367

            
cleanup
Yuki Kimoto authored on 2011-04-02
1368
sub _remove_duplicate_table {
1369
    my ($self, $tables, $main_table) = @_;
1370
    
1371
    # Remove duplicate table
1372
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1373
    delete $tables{$main_table} if $main_table;
1374
    
1375
    return [keys %tables, $main_table ? $main_table : ()];
1376
}
1377

            
cleanup
Yuki Kimoto authored on 2011-04-02
1378
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1379
    my ($self, $source) = @_;
1380
    
cleanup
Yuki Kimoto authored on 2011-04-02
1381
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1382
    my $tables = [];
1383
    my $safety_character = $self->safety_character;
1384
    my $q = $self->reserved_word_quote;
1385
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1386
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1387
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1388
    while ($source =~ /$table_re/g) {
1389
        push @$tables, $1;
1390
    }
1391
    
1392
    return $tables;
1393
}
1394

            
cleanup
Yuki Kimoto authored on 2011-04-02
1395
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1396
    my ($self, $where) = @_;
1397
    
cleanup
Yuki Kimoto authored on 2011-04-02
1398
    my $obj;
1399
    
1400
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1401
    if (ref $where eq 'HASH') {
1402
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1403
        my $q = $self->reserved_word_quote;
1404
        foreach my $column (keys %$where) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1405
            my $column_quote = "$q$column$q";
1406
            $column_quote =~ s/\./$q.$q/;
1407
            push @$clause, "$column_quote = :$column" for keys %$where;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1408
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1409
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1410
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1411
    
1412
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1413
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1414
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1415
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1416
    
1417
    # Array(DEPRECATED!)
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1418
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1419
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1420
             "use \$dbi->select(where => \$dbi->where(clause => " .
added warnings
Yuki Kimoto authored on 2011-06-07
1421
             "CLAUSE, where_param => PARAMETER));";
cleanup
Yuki Kimoto authored on 2011-04-02
1422
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1423
            clause => $where->[0],
1424
            param  => $where->[1]
1425
        );
1426
    }
1427
    
cleanup
Yuki Kimoto authored on 2011-04-02
1428
    # Check where argument
improved error messages
Yuki Kimoto authored on 2011-04-18
1429
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1430
        . qq{or array reference, which contains where clause and paramter}
cleanup
Yuki Kimoto authored on 2011-04-25
1431
        . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1432
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1433
    
cleanup
Yuki Kimoto authored on 2011-04-02
1434
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1435
}
1436

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1437
# DEPRECATED!
1438
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
1439
sub select_at {
1440
    my ($self, %args) = @_;
1441

            
updated pod
Yuki Kimoto authored on 2011-06-08
1442
    warn "select_at is DEPRECATED! use update and id option instead";
1443

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1444
    # Arguments
1445
    my $primary_keys = delete $args{primary_key};
1446
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1447
    my $where = delete $args{where};
1448
    my $param = delete $args{param};
1449
    
1450
    # Check arguments
1451
    foreach my $name (keys %args) {
1452
        croak qq{"$name" is wrong option } . _subname
1453
          unless $SELECT_AT_ARGS{$name};
1454
    }
1455
    
1456
    # Table
1457
    croak qq{"table" option must be specified } . _subname
1458
      unless $args{table};
1459
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1460
    
1461
    # Create where parameter
1462
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1463
    
1464
    return $self->select(where => $where_param, %args);
1465
}
1466

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1467
# DEPRECATED!
1468
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1469
sub delete_at {
1470
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1471

            
1472
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1473
    
1474
    # Arguments
1475
    my $primary_keys = delete $args{primary_key};
1476
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1477
    my $where = delete $args{where};
1478
    
1479
    # Check arguments
1480
    foreach my $name (keys %args) {
1481
        croak qq{"$name" is wrong option } . _subname
1482
          unless $DELETE_AT_ARGS{$name};
1483
    }
1484
    
1485
    # Create where parameter
1486
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1487
    
1488
    return $self->delete(where => $where_param, %args);
1489
}
1490

            
cleanup
Yuki Kimoto authored on 2011-06-08
1491
# DEPRECATED!
1492
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1493
sub update_at {
1494
    my $self = shift;
1495

            
1496
    warn "update_at is DEPRECATED! use update and id option instead";
1497
    
1498
    # Arguments
1499
    my $param;
1500
    $param = shift if @_ % 2;
1501
    my %args = @_;
1502
    my $primary_keys = delete $args{primary_key};
1503
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1504
    my $where = delete $args{where};
1505
    my $p = delete $args{param} || {};
1506
    $param  ||= $p;
1507
    
1508
    # Check arguments
1509
    foreach my $name (keys %args) {
1510
        croak qq{"$name" is wrong option } . _subname
1511
          unless $UPDATE_AT_ARGS{$name};
1512
    }
1513
    
1514
    # Create where parameter
1515
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1516
    
1517
    return $self->update(where => $where_param, param => $param, %args);
1518
}
1519

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1520
# DEPRECATED!
1521
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
1522
sub insert_at {
1523
    my $self = shift;
1524
    
1525
    warn "insert_at is DEPRECATED! use insert and id option instead";
1526
    
1527
    # Arguments
1528
    my $param;
1529
    $param = shift if @_ % 2;
1530
    my %args = @_;
1531
    my $primary_key = delete $args{primary_key};
1532
    $primary_key = [$primary_key] unless ref $primary_key;
1533
    my $where = delete $args{where};
1534
    my $p = delete $args{param} || {};
1535
    $param  ||= $p;
1536
    
1537
    # Check arguments
1538
    foreach my $name (keys %args) {
1539
        croak qq{"$name" is wrong option } . _subname
1540
          unless $INSERT_AT_ARGS{$name};
1541
    }
1542
    
1543
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1544
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1545
    $param = $self->merge_param($where_param, $param);
1546
    
1547
    return $self->insert(param => $param, %args);
1548
}
1549

            
added warnings
Yuki Kimoto authored on 2011-06-07
1550
# DEPRECATED!
1551
sub register_tag {
1552
    warn "register_tag is DEPRECATED!";
1553
    shift->query_builder->register_tag(@_)
1554
}
1555

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1556
# DEPRECATED!
1557
__PACKAGE__->attr('data_source');
1558

            
cleanup
Yuki Kimoto authored on 2011-01-25
1559
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1560
__PACKAGE__->attr(
1561
    dbi_options => sub { {} },
1562
    filter_check  => 1
1563
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1564

            
cleanup
Yuki Kimoto authored on 2011-01-25
1565
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1566
sub default_bind_filter {
1567
    my $self = shift;
1568
    
added warnings
Yuki Kimoto authored on 2011-06-07
1569
    warn "default_bind_filter is DEPRECATED! use apply_filter instead\n";
1570
    
cleanup
Yuki Kimoto authored on 2011-01-12
1571
    if (@_) {
1572
        my $fname = $_[0];
1573
        
1574
        if (@_ && !$fname) {
1575
            $self->{default_out_filter} = undef;
1576
        }
1577
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1578
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1579
              unless exists $self->filters->{$fname};
1580
        
1581
            $self->{default_out_filter} = $self->filters->{$fname};
1582
        }
1583
        return $self;
1584
    }
1585
    
1586
    return $self->{default_out_filter};
1587
}
1588

            
cleanup
Yuki Kimoto authored on 2011-01-25
1589
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1590
sub default_fetch_filter {
1591
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1592

            
1593
    warn "default_fetch_filter is DEPRECATED! use apply_filter instead\n";
cleanup
Yuki Kimoto authored on 2011-01-12
1594
    
1595
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1596
        my $fname = $_[0];
1597

            
cleanup
Yuki Kimoto authored on 2011-01-12
1598
        if (@_ && !$fname) {
1599
            $self->{default_in_filter} = undef;
1600
        }
1601
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1602
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1603
              unless exists $self->filters->{$fname};
1604
        
1605
            $self->{default_in_filter} = $self->filters->{$fname};
1606
        }
1607
        
1608
        return $self;
1609
    }
1610
    
many changed
Yuki Kimoto authored on 2011-01-23
1611
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1612
}
1613

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1614
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1615
sub insert_param_tag {
1616
    warn "insert_param_tag is DEPRECATED! " .
1617
         "use insert_param instead!";
1618
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1619
}
1620

            
cleanup
Yuki Kimoto authored on 2011-01-25
1621
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1622
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1623
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1624
    return shift->query_builder->register_tag_processor(@_);
1625
}
1626

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1627
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1628
sub update_param_tag {
fixed DEPRECATED message bug
Yuki Kimoto authored on 2011-06-10
1629
    warn "update_param_tag is DEPRECATED! " .
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1630
         "use update_param instead";
1631
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1632
}
cleanup
Yuki Kimoto authored on 2011-03-08
1633
# DEPRECATED!
1634
sub _push_relation {
1635
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1636
    
1637
    if (keys %{$relation || {}}) {
1638
        push @$sql, $need_where ? 'where' : 'and';
1639
        foreach my $rcolumn (keys %$relation) {
1640
            my $table1 = (split (/\./, $rcolumn))[0];
1641
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1642
            push @$tables, ($table1, $table2);
1643
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1644
        }
1645
    }
1646
    pop @$sql if $sql->[-1] eq 'and';    
1647
}
1648

            
1649
# DEPRECATED!
1650
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1651
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1652
    
1653
    if (keys %{$relation || {}}) {
1654
        foreach my $rcolumn (keys %$relation) {
1655
            my $table1 = (split (/\./, $rcolumn))[0];
1656
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1657
            my $table1_exists;
1658
            my $table2_exists;
1659
            foreach my $table (@$tables) {
1660
                $table1_exists = 1 if $table eq $table1;
1661
                $table2_exists = 1 if $table eq $table2;
1662
            }
1663
            unshift @$tables, $table1 unless $table1_exists;
1664
            unshift @$tables, $table2 unless $table2_exists;
1665
        }
1666
    }
1667
}
1668

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1671
=head1 NAME
1672

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

            
1675
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1676

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1677
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1678
    
1679
    # Connect
1680
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1681
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1682
        user => 'ken',
1683
        password => '!LFKD%$&',
1684
        dbi_option => {mysql_enable_utf8 => 1}
1685
    );
cleanup
yuki-kimoto authored on 2010-08-05
1686

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1687
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1688
    $dbi->insert(
1689
        table  => 'book',
1690
        param  => {title => 'Perl', author => 'Ken'}
1691
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1692
    
1693
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1694
    $dbi->update(
1695
        table  => 'book', 
1696
        param  => {title => 'Perl', author => 'Ken'}, 
1697
        where  => {id => 5},
1698
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1699
    
1700
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1701
    $dbi->delete(
1702
        table  => 'book',
1703
        where  => {author => 'Ken'},
1704
    );
cleanup
yuki-kimoto authored on 2010-08-05
1705

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1712
    # Select, more complex
1713
    my $result = $dbi->select(
1714
        table  => 'book',
1715
        column => [
1716
            'book.author as book__author',
1717
            'company.name as company__name'
1718
        ],
1719
        where  => {'book.author' => 'Ken'},
1720
        join => ['left outer join company on book.company_id = company.id'],
1721
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1722
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1723
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1724
    # Fetch
1725
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1726
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1727
    }
1728
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1729
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1730
    while (my $row = $result->fetch_hash) {
1731
        
1732
    }
1733
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1734
    # Execute SQL with parameter.
1735
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1736
        "select id from book where author = :author and title like :title",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1737
        param  => {author => 'ken', title => '%Perl%'}
1738
    );
1739
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1740
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1741

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

            
1744
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1745

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1750
There are many basic methods to execute various queries.
1751
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1752
C<delete_all()>, C<select()>,
- select() column option can...
Yuki Kimoto authored on 2011-06-08
1753
C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1754

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1755
=item *
1756

            
1757
Filter when data is send or receive.
1758

            
1759
=item *
1760

            
1761
Data filtering system
1762

            
1763
=item *
1764

            
1765
Model support.
1766

            
1767
=item *
1768

            
1769
Generate where clause dinamically.
1770

            
1771
=item *
1772

            
1773
Generate join clause dinamically.
1774

            
1775
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1776

            
1777
=head1 GUIDE
1778

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1787
=head2 C<connector>
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1788

            
1789
    my $connector = $dbi->connector;
1790
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1791

            
1792
Connection manager object. if connector is set, you can get C<dbh()>
1793
from connection manager. conection manager object must have dbh() mehtod.
1794

            
1795
This is L<DBIx::Connector> example. Please pass
1796
C<default_dbi_option> to L<DBIx::Connector>.
1797

            
1798
    my $connector = DBIx::Connector->new(
1799
        "dbi:mysql:database=$DATABASE",
1800
        $USER,
1801
        $PASSWORD,
1802
        DBIx::Custom->new->default_dbi_option
1803
    );
1804
    
1805
    my $dbi = DBIx::Custom->new(connector => $connector);
1806

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1807
=head2 C<dsn>
1808

            
1809
    my $dsn = $dbi->dsn;
1810
    $dbi    = $dbi->dsn("DBI:mysql:database=dbname");
packaging one directory
yuki-kimoto authored on 2009-11-16
1811

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1812
Data source name, used when C<connect()> is executed.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1813

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1814
C<data_source> is DEPRECATED! It is renamed to C<dsn>.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1815

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

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

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

            
1824
=head2 C<default_dbi_option>
1825

            
1826
    my $default_dbi_option = $dbi->default_dbi_option;
1827
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1828

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1832
    {
1833
        RaiseError => 1,
1834
        PrintError => 0,
1835
        AutoCommit => 1,
1836
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1837

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1848
=head2 C<models>
add models() attribute
Yuki Kimoto authored on 2011-02-21
1849

            
1850
    my $models = $dbi->models;
1851
    $dbi       = $dbi->models(\%models);
1852

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1855
=head2 C<password>
1856

            
1857
    my $password = $dbi->password;
1858
    $dbi         = $dbi->password('lkj&le`@s');
1859

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1869
=head2 C<reserved_word_quote>
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1870

            
1871
     my reserved_word_quote = $dbi->reserved_word_quote;
1872
     $dbi                   = $dbi->reserved_word_quote('"');
1873

            
cleanup
Yuki Kimoto authored on 2011-04-02
1874
Reserved word quote, default to empty string.
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1875

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1893
    my $user = $dbi->user;
1894
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1895

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

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

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

            
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1904
=head2 C<available_data_type> EXPERIMENTAL
1905

            
1906
    print $dbi->available_data_type;
1907

            
1908
Get available data type.
1909

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1910
=head2 C<apply_filter>
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1911

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1912
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1913
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1914
        'issue_date' => {
1915
            out => 'tp_to_date',
1916
            in  => 'date_to_tp',
1917
            end => 'tp_to_displaydate'
1918
        },
1919
        'write_date' => {
1920
            out => 'tp_to_date',
1921
            in  => 'date_to_tp',
1922
            end => 'tp_to_displaydate'
1923
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1924
    );
1925

            
update pod
Yuki Kimoto authored on 2011-03-13
1926
Apply filter to columns.
1927
C<out> filter is executed before data is send to database.
1928
C<in> filter is executed after a row is fetch.
1929
C<end> filter is execute after C<in> filter is executed.
1930

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1933
       PETTERN         EXAMPLE
1934
    1. Column        : author
1935
    2. Table.Column  : book.author
1936
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1937

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

            
1941
You can set multiple filters at once.
1942

            
1943
    $dbi->apply_filter(
1944
        'book',
1945
        [qw/issue_date write_date/] => {
1946
            out => 'tp_to_date',
1947
            in  => 'date_to_tp',
1948
            end => 'tp_to_displaydate'
1949
        }
1950
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1951

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1952
=head2 C<assign_param> EXPERIMENTAL
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1953

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1954
    my $assign_param = $dbi->assign_param({title => 'a', age => 2});
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1955

            
updated pod
Yuki Kimoto authored on 2011-06-09
1956
Create assign parameter.
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1957

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1958
    title = :title, author = :author
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1959

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1960
This is equal to C<update_param> exept that set is not added.
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1961

            
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
1962
=head2 C<col> EXPERIMETNAL
1963

            
1964
    my $column = $model->col(book => ['author', 'title']);
1965

            
1966
Create column clause. The follwoing column clause is created.
1967

            
1968
    book.author as "book.author",
1969
    book.title as "book.title"
1970

            
1971
=head2 C<column> EXPERIMETNAL
1972

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1982
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1983
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1984
        user => 'ken',
1985
        password => '!LFKD%$&',
1986
        dbi_option => {mysql_enable_utf8 => 1}
1987
    );
1988

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1997
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1998
        table => 'book',
1999
        primary_key => 'id',
2000
        join => [
2001
            'inner join company on book.comparny_id = company.id'
2002
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2003
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2004
            publish_date => {
2005
                out => 'tp_to_date',
2006
                in => 'date_to_tp',
2007
                end => 'tp_to_displaydate'
2008
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2009
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2010
    );
2011

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

            
2015
   $dbi->model('book')->select(...);
2016

            
cleanup
yuki-kimoto authored on 2010-10-17
2017
=head2 C<create_query>
2018
    
2019
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
2020
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
2021
    );
update document
yuki-kimoto authored on 2009-11-19
2022

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

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

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

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

            
2033
    my $dbh = $dbi->dbh;
2034

            
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2035
Get L<DBI> database handle. if C<connector> is set, you can get
2036
database handle from C<connector>.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2037

            
2038
=head2 C<each_column>
2039

            
2040
    $dbi->each_column(
2041
        sub {
2042
            my ($dbi, $table, $column, $column_info) = @_;
2043
            
2044
            my $type = $column_info->{TYPE_NAME};
2045
            
2046
            if ($type eq 'DATE') {
2047
                # ...
2048
            }
2049
        }
2050
    );
2051

            
2052
Iterate all column informations of all table from database.
2053
Argument is callback when one column is found.
2054
Callback receive four arguments, dbi object, table name,
2055
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
2056

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2059
    my $result = $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2060
        "select * from book where title = :title and author like :author",
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
2061
        {title => 'Perl', author => '%Ken%'}
update pod
Yuki Kimoto authored on 2011-03-13
2062
    );
2063

            
updated pod
Yuki Kimoto authored on 2011-06-09
2064
Execute SQL. SQL can contain parameter such as :author.
2065
Return value is L<DBIx::Custom::Result> when select statement is executed,
2066
or the count of affected rows in insert, update, delete statement is executed.
update pod
Yuki Kimoto authored on 2011-03-13
2067

            
updated pod
Yuki Kimoto authored on 2011-06-09
2068
Parameter is replaced by placeholder C<?>.
update pod
Yuki Kimoto authored on 2011-03-13
2069

            
2070
    select * from where title = ? and author like ?;
2071

            
updated pod
Yuki Kimoto authored on 2011-06-09
2072
The following opitons are available.
update pod
Yuki Kimoto authored on 2011-03-13
2073

            
2074
=over 4
2075

            
2076
=item C<filter>
updated pod
Yuki Kimoto authored on 2011-06-09
2077
    
2078
    filter => {
2079
        title  => sub { uc $_[0] }
2080
        author => sub { uc $_[0] }
2081
    }
update pod
Yuki Kimoto authored on 2011-03-13
2082

            
updated pod
Yuki Kimoto authored on 2011-06-09
2083
    # Filter name
2084
    filter => {
2085
        title  => 'upper_case',
2086
        author => 'upper_case'
2087
    }
2088
        
2089
    # At once
2090
    filter => [
2091
        [qw/title author/]  => sub { uc $_[0] }
2092
    ]
2093

            
2094
Filter, executed before data is saved into database.
update pod
Yuki Kimoto authored on 2011-03-13
2095
Filter value is code reference or
2096
filter name registerd by C<register_filter()>.
2097

            
2098
These filters are added to the C<out> filters, set by C<apply_filter()>.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2099

            
updated document
Yuki Kimoto authored on 2011-06-09
2100
=item C<query>
2101

            
2102
    query => 1
2103

            
2104
C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
2105

            
updated pod
Yuki Kimoto authored on 2011-06-09
2106
=item C<table>
2107
    
2108
    table => 'author'
2109
    table => ['author', 'book']
2110

            
2111
Table names for filtering.
2112

            
2113
Filtering by C<apply_filter> is off in C<execute> method,
2114
because we don't know what filter is applied.
2115

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2116
=item C<type>
2117

            
2118
Specify database data type.
2119

            
2120
    type => [image => DBI::SQL_BLOB]
2121
    type => [[qw/image audio/] => DBI::SQL_BLOB]
2122

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

            
2125
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2126

            
2127
C<type> option is also available
2128
by C<insert()>, C<update()>, C<delete()>, C<select()>.
2129

            
2130
=item C<type_rule_off> EXPERIMENTAL
2131

            
2132
    type_rule_off => 1
2133

            
2134
Trun type rule off.
update document
yuki-kimoto authored on 2009-11-19
2135

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

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2142
Execute delete statement.
update pod
Yuki Kimoto authored on 2011-03-13
2143

            
updated document
Yuki Kimoto authored on 2011-06-09
2144
The following opitons are available.
update pod
Yuki Kimoto authored on 2011-03-13
2145

            
update pod
Yuki Kimoto authored on 2011-03-13
2146
=over 4
2147

            
update pod
Yuki Kimoto authored on 2011-03-13
2148
=item C<append>
2149

            
updated document
Yuki Kimoto authored on 2011-06-09
2150
Same as C<select> method's C<append> option.
update pod
Yuki Kimoto authored on 2011-03-13
2151

            
2152
=item C<filter>
2153

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2154
Same as C<execute> method's C<filter> option.
update pod
Yuki Kimoto authored on 2011-03-13
2155

            
updated document
Yuki Kimoto authored on 2011-06-09
2156
=item C<id>
update pod
Yuki Kimoto authored on 2011-03-13
2157

            
updated document
Yuki Kimoto authored on 2011-06-09
2158
    id => 4
2159
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2160

            
updated document
Yuki Kimoto authored on 2011-06-09
2161
ID corresponding to C<primary_key>.
2162
You can delete rows by C<id> and C<primary_key>.
update pod
Yuki Kimoto authored on 2011-03-13
2163

            
updated document
Yuki Kimoto authored on 2011-06-09
2164
    $dbi->delete(
2165
        parimary_key => ['id1', 'id2'],
2166
        id => [4, 5],
2167
        table => 'book',
2168
    );
update pod
Yuki Kimoto authored on 2011-03-13
2169

            
updated document
Yuki Kimoto authored on 2011-06-09
2170
The above is same as the followin one.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2171

            
updated document
Yuki Kimoto authored on 2011-06-09
2172
    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2173

            
updated document
Yuki Kimoto authored on 2011-06-09
2174
=item C<query>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2175

            
updated document
Yuki Kimoto authored on 2011-06-09
2176
Same as C<execute> method's C<query> option.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2177

            
updated document
Yuki Kimoto authored on 2011-06-09
2178
=item C<table>
update pod
Yuki Kimoto authored on 2011-03-13
2179

            
updated document
Yuki Kimoto authored on 2011-06-09
2180
    table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2181

            
updated document
Yuki Kimoto authored on 2011-06-09
2182
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2183

            
updated document
Yuki Kimoto authored on 2011-06-09
2184
Same as C<select> method's C<where> option.
update pod
Yuki Kimoto authored on 2011-03-13
2185

            
updated pod
Yuki Kimoto authored on 2011-06-08
2186
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2187

            
updated pod
Yuki Kimoto authored on 2011-06-08
2188
See C<id> option.
update pod
Yuki Kimoto authored on 2011-03-13
2189

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2190
=item C<type>
2191

            
2192
Same as C<execute> method's C<type> option.
2193

            
2194
=item C<type_rule_off> EXPERIMENTAL
2195

            
2196
Same as C<execute> method's C<type_rule_off> option.
2197

            
updated pod
Yuki Kimoto authored on 2011-06-08
2198
=back
update pod
Yuki Kimoto authored on 2011-03-13
2199

            
updated pod
Yuki Kimoto authored on 2011-06-08
2200
=head2 C<delete_all>
update pod
Yuki Kimoto authored on 2011-03-13
2201

            
updated pod
Yuki Kimoto authored on 2011-06-08
2202
    $dbi->delete_all(table => $table);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2203

            
updated document
Yuki Kimoto authored on 2011-06-09
2204
Execute delete statement for all rows.
updated pod
Yuki Kimoto authored on 2011-06-08
2205
Options is same as C<delete()>.
update pod
Yuki Kimoto authored on 2011-03-13
2206

            
cleanup
yuki-kimoto authored on 2010-10-17
2207
=head2 C<insert>
2208

            
cleanup
Yuki Kimoto authored on 2011-06-09
2209
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
update pod
Yuki Kimoto authored on 2011-03-13
2210

            
cleanup
Yuki Kimoto authored on 2011-06-09
2211
Execute insert statement.
update pod
Yuki Kimoto authored on 2011-03-13
2212

            
cleanup
Yuki Kimoto authored on 2011-06-09
2213
The following opitons are available.
update pod
Yuki Kimoto authored on 2011-03-13
2214

            
cleanup
Yuki Kimoto authored on 2011-06-09
2215
=over 4
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2216

            
update pod
Yuki Kimoto authored on 2011-03-13
2217
=item C<append>
2218

            
cleanup
Yuki Kimoto authored on 2011-06-09
2219
Same as C<select> method's C<append> option.
update pod
Yuki Kimoto authored on 2011-03-13
2220

            
2221
=item C<filter>
2222

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2223
Same as C<execute> method's C<filter> option.
2224

            
2225
=item C<id>
2226

            
updated document
Yuki Kimoto authored on 2011-06-09
2227
    id => 4
2228
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2229

            
updated document
Yuki Kimoto authored on 2011-06-09
2230
ID corresponding to C<primary_key>.
2231
You can insert a row by C<id> and C<primary_key>.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2232

            
update pod
Yuki Kimoto authored on 2011-03-13
2233
    $dbi->insert(
updated document
Yuki Kimoto authored on 2011-06-09
2234
        {title => 'Perl', author => 'Ken'}
2235
        parimary_key => ['id1', 'id2'],
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2236
        id => [4, 5],
updated document
Yuki Kimoto authored on 2011-06-09
2237
        table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2238
    );
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2239

            
updated document
Yuki Kimoto authored on 2011-06-09
2240
The above is same as the followin one.
update pod
Yuki Kimoto authored on 2011-03-13
2241

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2242
    $dbi->insert(
updated document
Yuki Kimoto authored on 2011-06-09
2243
        {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'},
2244
        table => 'book'
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2245
    );
update pod
Yuki Kimoto authored on 2011-03-13
2246

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2247
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2248

            
updated document
Yuki Kimoto authored on 2011-06-09
2249
    primary_key => 'id'
2250
    primary_key => ['id1', 'id2']
update pod
Yuki Kimoto authored on 2011-03-13
2251

            
updated document
Yuki Kimoto authored on 2011-06-09
2252
Primary key. This is used by C<id> option.
cleanup
Yuki Kimoto authored on 2011-06-09
2253

            
2254
=item C<param>
2255

            
2256
    param => {title => 'Perl', author => 'Ken'}
2257

            
2258
Insert data.
2259

            
2260
If C<insert> method's arguments is odd numbers,
2261
first argument is received as C<param>.
2262

            
2263
    $dbi->insert({title => 'Perl', author => 'Ken'}, table => 'book');
2264

            
updated document
Yuki Kimoto authored on 2011-06-09
2265
=item C<query>
2266

            
2267
Same as C<execute> method's C<query> option.
2268

            
2269
=item C<table>
2270

            
2271
    table => 'book'
2272

            
2273
Table name.
2274

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2275
=item C<type>
cleanup
yuki-kimoto authored on 2010-10-17
2276

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2277
Same as C<execute> method's C<type> option.
cleanup
yuki-kimoto authored on 2010-10-17
2278

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2279
=item C<type_rule_off> EXPERIMENTAL
2280

            
updated document
Yuki Kimoto authored on 2011-06-09
2281
Same as C<execute> method's C<type_rule_off> option.
update pod
Yuki Kimoto authored on 2011-03-13
2282

            
update pod
Yuki Kimoto authored on 2011-03-13
2283
=back
2284

            
2285
=over 4
2286

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2287
=head2 C<insert_param>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2288

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2289
    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2290

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2291
Create insert parameters.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2292

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2293
    (title, author) values (title = :title, age = :age);
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2294

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2295
=head2 C<include_model>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2296

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2302
    lib / MyModel.pm
2303
        / MyModel / book.pm
2304
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2305

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

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

            
2310
    package MyModel;
2311
    
2312
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2313
    
2314
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2315

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2320
    package MyModel::book;
2321
    
2322
    use base 'MyModel';
2323
    
2324
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2325

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2328
    package MyModel::company;
2329
    
2330
    use base 'MyModel';
2331
    
2332
    1;
2333
    
2334
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2335

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2343
=head2 C<merge_param>
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2344

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

            
2347
Merge paramters.
2348

            
2349
$param:
2350

            
2351
    {key1 => [1, 1], key2 => 2}
2352

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2353
=head2 C<method>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2354

            
2355
    $dbi->method(
2356
        update_or_insert => sub {
2357
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2358
            
2359
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2360
        },
2361
        find_or_create   => sub {
2362
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2363
            
2364
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2365
        }
2366
    );
2367

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

            
2370
    $dbi->update_or_insert;
2371
    $dbi->find_or_create;
2372

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2373
=head2 C<model>
update pod
Yuki Kimoto authored on 2011-03-13
2374

            
2375
    $dbi->model('book')->method(
2376
        insert => sub { ... },
2377
        update => sub { ... }
2378
    );
2379
    
2380
    my $model = $dbi->model('book');
2381

            
2382
Set and get a L<DBIx::Custom::Model> object,
2383

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2384
=head2 C<mycolumn>
cleanup
Yuki Kimoto authored on 2011-03-21
2385

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

            
2388
Create column clause for myself. The follwoing column clause is created.
2389

            
2390
    book.author as author,
2391
    book.title as title
2392

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2395
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2396
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2397
        user => 'ken',
2398
        password => '!LFKD%$&',
2399
        dbi_option => {mysql_enable_utf8 => 1}
2400
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2401

            
2402
Create a new L<DBIx::Custom> object.
2403

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

            
2406
    my $not_exists = $dbi->not_exists;
2407

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2411
=head2 C<register_filter>
2412

            
update pod
Yuki Kimoto authored on 2011-03-13
2413
    $dbi->register_filter(
2414
        # Time::Piece object to database DATE format
2415
        tp_to_date => sub {
2416
            my $tp = shift;
2417
            return $tp->strftime('%Y-%m-%d');
2418
        },
2419
        # database DATE format to Time::Piece object
2420
        date_to_tp => sub {
2421
           my $date = shift;
2422
           return Time::Piece->strptime($date, '%Y-%m-%d');
2423
        }
2424
    );
cleanup
yuki-kimoto authored on 2010-10-17
2425
    
update pod
Yuki Kimoto authored on 2011-03-13
2426
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2427

            
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2428
=head2 C<type_rule> EXPERIMENTAL
2429

            
2430
    $dbi->type_rule(
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2431
        into => {
2432
            DATE => sub { ... },
2433
            DATETIME => sub { ... }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2434
        },
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2435
        from => {
2436
            # DATE
2437
            9 => sub { ... },
2438
            
2439
            # DATETIME or TIMESTAMP
2440
            11 => sub { ... },
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2441
        }
2442
    );
2443

            
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2444
Filtering rule when data is send into and get from database.
2445
This has a little complex problem. 
2446
In C<into> you can specify type name as same as type name defined
2447
by create table, such as C<DATETIME> or C<DATE>.
2448
but in C<from> you can't specify type name defined by create table.
2449
You must specify data type, this is internal one.
2450
You get all data type by C<available_data_type>.
2451

            
2452
    print $dbi->available_data_type;
2453

            
2454
You can also specify multiple types
2455

            
2456
    $dbi->type_rule(
2457
        into => [
2458
            [qw/DATE DATETIME/] => sub { ... },
2459
        ],
2460
        from => {
2461
            # DATE
2462
            [qw/9 11/] => sub { ... },
2463
        }
2464
    );
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2465

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2468
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2469
        table  => 'book',
2470
        column => ['author', 'title'],
2471
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2472
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2473
    
updated document
Yuki Kimoto authored on 2011-06-09
2474
Execute select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2475

            
updated document
Yuki Kimoto authored on 2011-06-09
2476
The following opitons are available.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2477

            
2478
=over 4
2479

            
updated document
Yuki Kimoto authored on 2011-06-09
2480
=item C<append>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2481

            
updated document
Yuki Kimoto authored on 2011-06-09
2482
    append => 'order by title'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2483

            
updated document
Yuki Kimoto authored on 2011-06-09
2484
Append statement to last of SQL.
2485
    
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2486
=item C<column>
2487
    
updated document
Yuki Kimoto authored on 2011-06-09
2488
    column => 'author'
2489
    column => ['author', 'title']
2490

            
2491
Column clause.
updated pod
Yuki Kimoto authored on 2011-06-07
2492
    
updated document
Yuki Kimoto authored on 2011-06-09
2493
if C<column> is not specified, '*' is set.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2494

            
updated document
Yuki Kimoto authored on 2011-06-09
2495
    column => '*'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2496

            
updated document
Yuki Kimoto authored on 2011-06-09
2497
You can specify hash reference in array reference. This is EXPERIMENTAL.
updated pod
Yuki Kimoto authored on 2011-06-07
2498

            
updated document
Yuki Kimoto authored on 2011-06-09
2499
    column => [
updated pod
Yuki Kimoto authored on 2011-06-07
2500
        {book => [qw/author title/]},
2501
        {person => [qw/name age/]}
updated document
Yuki Kimoto authored on 2011-06-09
2502
    ]
updated pod
Yuki Kimoto authored on 2011-06-07
2503

            
updated document
Yuki Kimoto authored on 2011-06-09
2504
This is expanded to the following one by using C<col> method.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2505

            
2506
    book.author as "book.author",
2507
    book.title as "book.title",
2508
    person.name as "person.name",
2509
    person.age as "person.age"
2510

            
updated document
Yuki Kimoto authored on 2011-06-09
2511
You can specify array reference in array reference.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2512

            
updated document
Yuki Kimoto authored on 2011-06-09
2513
    column => [
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2514
        ['date(book.register_datetime)', as => 'book.register_date']
updated document
Yuki Kimoto authored on 2011-06-09
2515
    ];
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2516

            
updated document
Yuki Kimoto authored on 2011-06-09
2517
Alias is quoted and joined.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2518

            
2519
    date(book.register_datetime) as "book.register_date"
updated pod
Yuki Kimoto authored on 2011-06-07
2520

            
updated document
Yuki Kimoto authored on 2011-06-09
2521
=item C<filter>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2522

            
updated document
Yuki Kimoto authored on 2011-06-09
2523
Same as C<execute> method's C<filter> option.
2524

            
2525
=item C<id>
2526

            
2527
    id => 4
2528
    id => [4, 5]
2529

            
2530
ID corresponding to C<primary_key>.
2531
You can select rows by C<id> and C<primary_key>.
2532

            
2533
    $dbi->select(
2534
        parimary_key => ['id1', 'id2'],
2535
        id => [4, 5],
2536
        table => 'book'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2537
    );
2538

            
updated document
Yuki Kimoto authored on 2011-06-09
2539
The above is same as the followin one.
2540

            
updated pod
Yuki Kimoto authored on 2011-04-25
2541
    $dbi->select(
updated document
Yuki Kimoto authored on 2011-06-09
2542
        where => {id1 => 4, id2 => 5},
2543
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2544
    );
2545
    
updated document
Yuki Kimoto authored on 2011-06-09
2546
=item C<param> EXPERIMETNAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2547

            
updated document
Yuki Kimoto authored on 2011-06-09
2548
    param => {'table2.key3' => 5}
update pod
Yuki Kimoto authored on 2011-03-12
2549

            
updated document
Yuki Kimoto authored on 2011-06-09
2550
Parameter shown before where clause.
2551
    
2552
For example, if you want to contain tag in join clause, 
2553
you can pass parameter by C<param> option.
update pod
Yuki Kimoto authored on 2011-03-12
2554

            
updated document
Yuki Kimoto authored on 2011-06-09
2555
    join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
2556
              ' as table2 on table1.key1 = table2.key1']
2557

            
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
2558
=itme C<prefix> EXPERIMENTAL
2559

            
2560
    prefix => 'SQL_CALC_FOUND_ROWS'
2561

            
2562
Prefix of column cluase
2563

            
2564
    select SQL_CALC_FOUND_ROWS title, author from book;
2565

            
updated document
Yuki Kimoto authored on 2011-06-09
2566
=item C<join>
2567

            
2568
    join => [
2569
        'left outer join company on book.company_id = company_id',
2570
        'left outer join location on company.location_id = location.id'
2571
    ]
2572
        
2573
Join clause. If column cluase or where clause contain table name like "company.name",
2574
join clausees needed when SQL is created is used automatically.
update pod
Yuki Kimoto authored on 2011-03-12
2575

            
2576
    $dbi->select(
2577
        table => 'book',
2578
        column => ['company.location_id as company__location_id'],
2579
        where => {'company.name' => 'Orange'},
2580
        join => [
2581
            'left outer join company on book.company_id = company.id',
2582
            'left outer join location on company.location_id = location.id'
2583
        ]
2584
    );
2585

            
updated document
Yuki Kimoto authored on 2011-06-09
2586
In above select, column and where clause contain "company" table,
2587
the following SQL is created
update pod
Yuki Kimoto authored on 2011-03-12
2588

            
2589
    select company.location_id as company__location_id
2590
    from book
2591
      left outer join company on book.company_id = company.id
2592
    where company.name = Orange
2593

            
updated document
Yuki Kimoto authored on 2011-06-09
2594
=item C<primary_key>
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2595

            
updated document
Yuki Kimoto authored on 2011-06-09
2596
    primary_key => 'id'
2597
    primary_key => ['id1', 'id2']
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2598

            
updated document
Yuki Kimoto authored on 2011-06-09
2599
Primary key. This is used by C<id> option.
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2600

            
updated document
Yuki Kimoto authored on 2011-06-09
2601
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-12
2602

            
updated document
Yuki Kimoto authored on 2011-06-09
2603
Same as C<execute> method's C<query> option.
update pod
Yuki Kimoto authored on 2011-03-12
2604

            
updated document
Yuki Kimoto authored on 2011-06-09
2605
=item C<type>
updated pod
Yuki Kimoto authored on 2011-06-08
2606

            
updated document
Yuki Kimoto authored on 2011-06-09
2607
Same as C<execute> method's C<type> option.
updated pod
Yuki Kimoto authored on 2011-06-08
2608

            
updated document
Yuki Kimoto authored on 2011-06-09
2609
=item C<table>
updated pod
Yuki Kimoto authored on 2011-06-08
2610

            
updated document
Yuki Kimoto authored on 2011-06-09
2611
    table => 'book'
updated pod
Yuki Kimoto authored on 2011-06-08
2612

            
updated document
Yuki Kimoto authored on 2011-06-09
2613
Table name.
updated pod
Yuki Kimoto authored on 2011-06-08
2614

            
updated document
Yuki Kimoto authored on 2011-06-09
2615
=item C<type_rule_off> EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-08
2616

            
updated document
Yuki Kimoto authored on 2011-06-09
2617
Same as C<execute> method's C<type_rule_off> option.
updated pod
Yuki Kimoto authored on 2011-06-08
2618

            
updated document
Yuki Kimoto authored on 2011-06-09
2619
=item C<where>
2620
    
2621
    # Hash refrence
2622
    where => {author => 'Ken', 'title' => 'Perl'}
2623
    
2624
    # DBIx::Custom::Where object
2625
    where => $dbi->where(
2626
        clause => ['and', 'author = :author', 'title like :title'],
2627
        param  => {author => 'Ken', title => '%Perl%'}
2628
    );
updated pod
Yuki Kimoto authored on 2011-06-08
2629

            
updated document
Yuki Kimoto authored on 2011-06-09
2630
    # String(with where_param option)
2631
    where => 'title like :title',
2632
    where_param => {title => '%Perl%'}
update pod
Yuki Kimoto authored on 2011-03-12
2633

            
updated document
Yuki Kimoto authored on 2011-06-09
2634
Where clause.
2635
    
improved pod
Yuki Kimoto authored on 2011-04-19
2636
=item C<wrap> EXPERIMENTAL
2637

            
2638
Wrap statement. This is array reference.
2639

            
2640
    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2641

            
2642
This option is for Oracle and SQL Server paging process.
2643

            
update pod
Yuki Kimoto authored on 2011-03-12
2644
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2645

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2648
    $dbi->update({title => 'Perl'}, table  => 'book', where  => {id => 4});
removed reconnect method
yuki-kimoto authored on 2010-05-28
2649

            
updated document
Yuki Kimoto authored on 2011-06-09
2650
Execute update statement.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2651

            
updated document
Yuki Kimoto authored on 2011-06-09
2652
The following opitons are available.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2653

            
update pod
Yuki Kimoto authored on 2011-03-13
2654
=over 4
2655

            
updated document
Yuki Kimoto authored on 2011-06-09
2656
=item C<append>
update pod
Yuki Kimoto authored on 2011-03-13
2657

            
updated document
Yuki Kimoto authored on 2011-06-09
2658
Same as C<select> method's C<append> option.
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2659

            
updated document
Yuki Kimoto authored on 2011-06-09
2660
=item C<filter>
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2661

            
updated document
Yuki Kimoto authored on 2011-06-09
2662
Same as C<execute> method's C<filter> option.
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2663

            
updated document
Yuki Kimoto authored on 2011-06-09
2664
=item C<id>
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2665

            
updated document
Yuki Kimoto authored on 2011-06-09
2666
    id => 4
2667
    id => [4, 5]
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2668

            
updated document
Yuki Kimoto authored on 2011-06-09
2669
ID corresponding to C<primary_key>.
2670
You can update rows by C<id> and C<primary_key>.
update pod
Yuki Kimoto authored on 2011-03-13
2671

            
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2672
    $dbi->update(
updated document
Yuki Kimoto authored on 2011-06-09
2673
        {title => 'Perl', author => 'Ken'}
2674
        parimary_key => ['id1', 'id2'],
2675
        id => [4, 5],
2676
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2677
    );
update pod
Yuki Kimoto authored on 2011-03-13
2678

            
updated document
Yuki Kimoto authored on 2011-06-09
2679
The above is same as the followin one.
update pod
Yuki Kimoto authored on 2011-03-13
2680

            
updated document
Yuki Kimoto authored on 2011-06-09
2681
    $dbi->update(
2682
        {title => 'Perl', author => 'Ken'}
2683
        where => {id1 => 4, id2 => 5},
2684
        table => 'book'
2685
    );
update pod
Yuki Kimoto authored on 2011-03-13
2686

            
updated document
Yuki Kimoto authored on 2011-06-09
2687
=item C<param>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2688

            
updated document
Yuki Kimoto authored on 2011-06-09
2689
    param => {title => 'Perl'}
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2690

            
updated document
Yuki Kimoto authored on 2011-06-09
2691
Update data.
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2692

            
updated document
Yuki Kimoto authored on 2011-06-09
2693
If C<update> method's arguments is odd numbers, first argument is received as C<param>.
update pod
Yuki Kimoto authored on 2011-03-13
2694

            
updated document
Yuki Kimoto authored on 2011-06-09
2695
    $dbi->update({title => 'Perl'}, table => 'book', where => {id => 2});
update pod
Yuki Kimoto authored on 2011-03-13
2696

            
updated document
Yuki Kimoto authored on 2011-06-09
2697
=item C<primary_key>
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2698

            
updated document
Yuki Kimoto authored on 2011-06-09
2699
    primary_key => 'id'
2700
    primary_key => ['id1', 'id2']
update pod
Yuki Kimoto authored on 2011-03-13
2701

            
updated document
Yuki Kimoto authored on 2011-06-09
2702
Primary key. This is used by C<id> option.
update pod
Yuki Kimoto authored on 2011-03-13
2703

            
updated document
Yuki Kimoto authored on 2011-06-09
2704
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
2705

            
updated document
Yuki Kimoto authored on 2011-06-09
2706
Same as C<execute> method's C<query> option.
update pod
Yuki Kimoto authored on 2011-03-13
2707

            
updated document
Yuki Kimoto authored on 2011-06-09
2708
=item C<table>
update pod
Yuki Kimoto authored on 2011-03-13
2709

            
updated document
Yuki Kimoto authored on 2011-06-09
2710
    table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2711

            
updated document
Yuki Kimoto authored on 2011-06-09
2712
Table name.
update pod
Yuki Kimoto authored on 2011-03-13
2713

            
updated document
Yuki Kimoto authored on 2011-06-09
2714
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2715

            
updated document
Yuki Kimoto authored on 2011-06-09
2716
Same as C<select> method's C<where> option.
update pod
Yuki Kimoto authored on 2011-03-13
2717

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2718
=item C<type>
2719

            
2720
Same as C<execute> method's C<type> option.
2721

            
2722
=item C<type_rule_off> EXPERIMENTAL
2723

            
2724
Turn type rule off.
2725

            
updated pod
Yuki Kimoto authored on 2011-06-08
2726
=back
update pod
Yuki Kimoto authored on 2011-03-13
2727

            
updated pod
Yuki Kimoto authored on 2011-06-08
2728
=head2 C<update_all>
update pod
Yuki Kimoto authored on 2011-03-13
2729

            
updated pod
Yuki Kimoto authored on 2011-06-08
2730
    $dbi->update_all(table => 'book', param => {title => 'Perl'});
update pod
Yuki Kimoto authored on 2011-03-13
2731

            
updated document
Yuki Kimoto authored on 2011-06-09
2732
Execute update statement for all rows.
updated pod
Yuki Kimoto authored on 2011-06-08
2733
Options is same as C<update()>.
update pod
Yuki Kimoto authored on 2011-03-13
2734

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2735
=head2 C<update_param>
update pod
Yuki Kimoto authored on 2011-03-13
2736

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2737
    my $update_param = $dbi->update_param({title => 'a', age => 2});
update pod
Yuki Kimoto authored on 2011-03-13
2738

            
2739
Create update parameter tag.
2740

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2741
    set title = :title, author = :author
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2742

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2743
C<no_set> option is DEPRECATED! use C<assing_param> instead.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2744

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2747
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2748
        clause => ['and', 'title = :title', 'author = :author'],
cleanup
Yuki Kimoto authored on 2011-03-09
2749
        param => {title => 'Perl', author => 'Ken'}
2750
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2751

            
2752
Create a new L<DBIx::Custom::Where> object.
2753

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2754
=head2 C<setup_model>
cleanup
Yuki Kimoto authored on 2011-01-12
2755

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2761
=head2 C<update_at()> DEPRECATED!
2762

            
2763
Update statement, using primary key.
2764

            
2765
    $dbi->update_at(
2766
        table => 'book',
2767
        primary_key => 'id',
2768
        where => '5',
2769
        param => {title => 'Perl'}
2770
    );
2771

            
2772
This method is same as C<update()> exept that
2773
C<primary_key> is specified and C<where> is constant value or array refrence.
2774
all option of C<update()> is available.
2775

            
2776
=head2 C<delete_at()> DEPRECATED!
2777

            
2778
Delete statement, using primary key.
2779

            
2780
    $dbi->delete_at(
2781
        table => 'book',
2782
        primary_key => 'id',
2783
        where => '5'
2784
    );
2785

            
2786
This method is same as C<delete()> exept that
2787
C<primary_key> is specified and C<where> is constant value or array refrence.
2788
all option of C<delete()> is available.
2789

            
2790
=head2 C<select_at()> DEPRECATED!
2791

            
2792
Select statement, using primary key.
2793

            
2794
    $dbi->select_at(
2795
        table => 'book',
2796
        primary_key => 'id',
2797
        where => '5'
2798
    );
2799

            
2800
This method is same as C<select()> exept that
2801
C<primary_key> is specified and C<where> is constant value or array refrence.
2802
all option of C<select()> is available.
2803

            
2804
=head2 C<register_tag> DEPRECATED!
2805

            
2806
    $dbi->register_tag(
2807
        update => sub {
2808
            my @columns = @_;
2809
            
2810
            # Update parameters
2811
            my $s = 'set ';
2812
            $s .= "$_ = ?, " for @columns;
2813
            $s =~ s/, $//;
2814
            
2815
            return [$s, \@columns];
2816
        }
2817
    );
2818

            
2819
Register tag, used by C<execute()>.
2820

            
2821
See also L<Tags/Tags> about tag registered by default.
2822

            
2823
Tag parser receive arguments specified in tag.
2824
In the following tag, 'title' and 'author' is parser arguments
2825

            
2826
    {update_param title author} 
2827

            
2828
Tag parser must return array refrence,
2829
first element is the result statement, 
2830
second element is column names corresponding to place holders.
2831

            
2832
In this example, result statement is 
2833

            
2834
    set title = ?, author = ?
2835

            
2836
Column names is
2837

            
2838
    ['title', 'author']
2839

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2840
=head1 Parameter
2841

            
2842
Parameter start at ':'. This is replaced to place holoder
2843

            
2844
    $dbi->execute(
2845
        "select * from book where title = :title and author = :author"
2846
        param => {title => 'Perl', author => 'Ken'}
2847
    );
2848

            
2849
    "select * from book where title = ? and author = ?"
2850

            
2851
=head1 Tags DEPRECATED!
2852

            
2853
B<Tag> system is DEPRECATED! use parameter system :name instead.
2854
Parameter is simple and readable.
2855

            
2856
Note that you can't use both tag and paramter at same time.
cleanup
Yuki Kimoto authored on 2011-01-25
2857

            
2858
The following tags is available.
2859

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2860
=head2 C<?> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2861

            
2862
Placeholder tag.
2863

            
2864
    {? NAME}    ->   ?
2865

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2866
=head2 C<=> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2867

            
2868
Equal tag.
2869

            
2870
    {= NAME}    ->   NAME = ?
2871

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2872
=head2 C<E<lt>E<gt>> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2873

            
2874
Not equal tag.
2875

            
2876
    {<> NAME}   ->   NAME <> ?
2877

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2878
=head2 C<E<lt>> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2879

            
2880
Lower than tag
2881

            
2882
    {< NAME}    ->   NAME < ?
2883

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2884
=head2 C<E<gt>> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2885

            
2886
Greater than tag
2887

            
2888
    {> NAME}    ->   NAME > ?
2889

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2890
=head2 C<E<gt>=> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2891

            
2892
Greater than or equal tag
2893

            
2894
    {>= NAME}   ->   NAME >= ?
2895

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2896
=head2 C<E<lt>=> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2897

            
2898
Lower than or equal tag
2899

            
2900
    {<= NAME}   ->   NAME <= ?
2901

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2902
=head2 C<like> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2903

            
2904
Like tag
2905

            
2906
    {like NAME}   ->   NAME like ?
2907

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2908
=head2 C<in> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2909

            
2910
In tag.
2911

            
2912
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2913

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2914
=head2 C<insert_param> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2915

            
2916
Insert parameter tag.
2917

            
2918
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2919

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2920
=head2 C<update_param> DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-25
2921

            
2922
Updata parameter tag.
2923

            
2924
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2925

            
updated pod
Yuki Kimoto authored on 2011-06-08
2926
=head2 C<insert_at()> DEPRECATED!
2927

            
2928
Insert statement, using primary key.
2929

            
2930
    $dbi->insert_at(
2931
        table => 'book',
2932
        primary_key => 'id',
2933
        where => '5',
2934
        param => {title => 'Perl'}
2935
    );
2936

            
2937
This method is same as C<insert()> exept that
2938
C<primary_key> is specified and C<where> is constant value or array refrence.
2939
all option of C<insert()> is available.
2940

            
added environment variable D...
Yuki Kimoto authored on 2011-04-02
2941
=head1 ENVIRONMENT VARIABLE
2942

            
2943
=head2 C<DBIX_CUSTOM_DEBUG>
2944

            
2945
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
improved debug message
Yuki Kimoto authored on 2011-05-23
2946
executed SQL and bind values are printed to STDERR.
2947

            
2948
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2949

            
2950
DEBUG output encoding. Default to UTF-8.
added environment variable D...
Yuki Kimoto authored on 2011-04-02
2951

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

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

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

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

            
2961
C<< <kimoto.yuki at gmail.com> >>
2962

            
2963
L<http://github.com/yuki-kimoto/DBIx-Custom>
2964

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2965
=head1 AUTHOR
2966

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

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

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

            
2973
This program is free software; you can redistribute it and/or modify it
2974
under the same terms as Perl itself.
2975

            
2976
=cut