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

            
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3
our $VERSION = '0.1685';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

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

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

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
25
our @COMMON_ARGS = qw/table query filter type id primary_key/;
cleanup
Yuki Kimoto authored on 2011-03-21
26

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

            
added helper method
yuki-kimoto authored on 2010-10-17
66
our $AUTOLOAD;
67
sub AUTOLOAD {
68
    my $self = shift;
69

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

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

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

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

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

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

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

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

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

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

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

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

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

            
304
        return $self->{dbh};
update pod
Yuki Kimoto authored on 2011-03-13
305
    }
306
}
307

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
352
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
353
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
354
    my $q = $self->reserved_word_quote;
355
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
356
    push @sql, $append if $append;
357
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
358
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
359
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
360
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
361
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
362
    
packaging one directory
yuki-kimoto authored on 2009-11-16
363
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
364
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
365
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
366
        param => $where_param,
cleanup
Yuki Kimoto authored on 2011-03-21
367
        table => $table,
368
        %args
369
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
370
}
371

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

            
added helper method
yuki-kimoto authored on 2010-10-17
374
sub DESTROY { }
375

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

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

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

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

            
434
sub execute {
cleanup
yuki-kimoto authored on 2010-10-17
435
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
436
    
cleanup
Yuki Kimoto authored on 2011-04-02
437
    # Arguments
cleanup
Yuki Kimoto authored on 2011-04-02
438
    my $param  = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
439
    my $tables = delete $args{table} || [];
440
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
441
    my $filter = delete $args{filter};
cleanup
Yuki Kimoto authored on 2011-04-25
442
    $filter = _array_to_hash($filter);
cleanup
Yuki Kimoto authored on 2011-04-02
443
    my $type = delete $args{type};
cleanup
Yuki Kimoto authored on 2011-04-25
444
    $type = _array_to_hash($type);
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
445
    
cleanup
Yuki Kimoto authored on 2011-03-09
446
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
447
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
448
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
449
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
450
    }
451
    
cleanup
Yuki Kimoto authored on 2011-04-02
452
    # Create query
453
    $query = $self->create_query($query) unless ref $query;
cleanup
Yuki Kimoto authored on 2011-04-02
454
    $filter ||= $query->filter;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
455
    
cleanup
Yuki Kimoto authored on 2011-04-02
456
    # Tables
457
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
458
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
459
    $tables = $self->_remove_duplicate_table($tables, $main_table);
460
    if (my $q = $self->reserved_word_quote) {
461
        $_ =~ s/$q//g for @$tables;
462
    }
cleanup
Yuki Kimoto authored on 2011-04-02
463
    
464
    # Table alias
cleanup
Yuki Kimoto authored on 2011-04-02
465
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
466
        
cleanup
Yuki Kimoto authored on 2011-04-02
467
        # No need
468
        next unless my $alias = $self->{_table_alias}->{$table};
469
        $self->{filter} ||= {};
470
        next if $self->{filter}{out}{$table};
471
        
472
        # Filter
473
        $self->{filter}{out} ||= {};
474
        $self->{filter}{in}  ||= {};
475
        $self->{filter}{end} ||= {};
476
        
477
        # Create alias filter
478
        foreach my $type (qw/out in end/) {
479
            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};
480
            foreach my $filter_name (@filter_names) {
481
                my $filter_name_alias = $filter_name;
482
                $filter_name_alias =~ s/^$alias\./$table\./;
483
                $filter_name_alias =~ s/^${alias}__/${table}__/; 
484
                $self->{filter}{$type}{$table}{$filter_name_alias}
485
                  = $self->{filter}{$type}{$alias}{$filter_name}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
486
            }
487
        }
488
    }
cleanup
Yuki Kimoto authored on 2011-04-02
489
    
490
    # Applied filter
491
    my $applied_filter = {};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
492
    foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
493
        $applied_filter = {
494
            %$applied_filter,
cleanup
Yuki Kimoto authored on 2011-01-12
495
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
496
        }
497
    }
cleanup
Yuki Kimoto authored on 2011-04-02
498
    $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
499
    
cleanup
Yuki Kimoto authored on 2011-04-02
500
    # Replace filter name to code
501
    foreach my $column (keys %$filter) {
502
        my $name = $filter->{$column};
503
        if (!defined $name) {
504
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
505
        }
cleanup
Yuki Kimoto authored on 2011-04-02
506
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
507
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
508
            unless exists $self->filters->{$name};
509
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
510
        }
511
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
512
    
cleanup
Yuki Kimoto authored on 2011-04-02
513
    # Create bind values
514
    my $bind = $self->_create_bind_values(
515
        $param,
516
        $query->columns,
517
        $filter,
518
        $type
519
    );
cleanup
yuki-kimoto authored on 2010-10-17
520
    
521
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
522
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
523
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
524
    eval {
525
        for (my $i = 0; $i < @$bind; $i++) {
cleanup
Yuki Kimoto authored on 2011-04-02
526
            my $type = $bind->[$i]->{type};
527
            $sth->bind_param($i + 1, $bind->[$i]->{value}, $type ? $type : ());
cleanup
Yuki Kimoto authored on 2011-03-21
528
        }
529
        $affected = $sth->execute;
530
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
531
    
532
    if ($@) {
533
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
534
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
535
    }
cleanup
yuki-kimoto authored on 2010-10-17
536
    
improved debug message
Yuki Kimoto authored on 2011-05-23
537
    # DEBUG message
538
    if (DEBUG) {
539
        print STDERR "SQL:\n" . $query->sql . "\n";
540
        my @output;
541
        foreach my $b (@$bind) {
542
            my $value = $b->{value};
543
            $value = 'undef' unless defined $value;
544
            $value = encode(DEBUG_ENCODING(), $value)
545
              if utf8::is_utf8($value);
546
            push @output, $value;
547
        }
548
        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
549
    }
added environment variable D...
Yuki Kimoto authored on 2011-04-02
550
    
cleanup
Yuki Kimoto authored on 2011-04-02
551
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
552
    if ($sth->{NUM_OF_FIELDS}) {
553
        
cleanup
Yuki Kimoto authored on 2011-04-02
554
        # Filter
555
        my $filter = {};
556
        $filter->{in}  = {};
557
        $filter->{end} = {};
cleanup
Yuki Kimoto authored on 2011-01-12
558
        foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
559
            foreach my $way (qw/in end/) {
560
                $filter->{$way} = {
561
                    %{$filter->{$way}},
562
                    %{$self->{filter}{$way}{$table} || {}}
563
                };
564
            }
cleanup
Yuki Kimoto authored on 2011-01-12
565
        }
566
        
567
        # Result
568
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
569
            sth            => $sth,
570
            filters        => $self->filters,
cleanup
Yuki Kimoto authored on 2011-01-12
571
            default_filter => $self->{default_in_filter},
cleanup
Yuki Kimoto authored on 2011-04-02
572
            filter         => $filter->{in} || {},
573
            end_filter     => $filter->{end} || {}
cleanup
yuki-kimoto authored on 2010-10-17
574
        );
575

            
576
        return $result;
577
    }
cleanup
Yuki Kimoto authored on 2011-04-02
578
    
579
    # Not select statement
580
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
581
}
582

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

            
cleanup
yuki-kimoto authored on 2010-10-17
585
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
586
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
587
    
cleanup
yuki-kimoto authored on 2010-10-17
588
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
589
    my $param;
590
    $param = shift if @_ % 2;
591
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
592
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
593
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
594
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
595
    my $p = delete $args{param} || {};
596
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
597
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
598
    my $query_return  = delete $args{query};
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
599
    my $id = delete $args{id};
600
    my $primary_key = delete $args{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
601
    croak "insert method primary_key option " .
added tests
Yuki Kimoto authored on 2011-06-08
602
          "must be specified when id is specified " . _subname
603
      if defined $id && !defined $primary_key;
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
604
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
605

            
606
    # Check arguments
607
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
608
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
609
          unless $INSERT_ARGS{$name};
610
    }
611

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
612
    # Merge parameter
613
    if ($id) {
cleanup
Yuki Kimoto authored on 2011-06-08
614
        my $id_param = $self->_create_param_from_id($id, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
615
        $param = $self->merge_param($id_param, $param);
616
    }
617

            
cleanup
Yuki Kimoto authored on 2011-04-02
618
    # Reserved word quote
619
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
620
    
cleanup
Yuki Kimoto authored on 2011-04-02
621
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
622
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
623
    push @sql, "insert into $q$table$q " . $self->insert_param($param);
cleanup
Yuki Kimoto authored on 2011-01-27
624
    push @sql, $append if $append;
625
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
626
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
627
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
628
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
629
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
630
    
packaging one directory
yuki-kimoto authored on 2009-11-16
631
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
632
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
633
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
634
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
635
        table => $table,
636
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
637
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
638
}
639

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
640
sub insert_param {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
641
    my ($self, $param) = @_;
642
    
cleanup
Yuki Kimoto authored on 2011-04-02
643
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
644
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
645
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
646
    my @columns;
647
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
648
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
649
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
650
          unless $column =~ /^[$safety\.]+$/;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
651
        my $column_quote = "$q$column$q";
652
        $column_quote =~ s/\./$q.$q/;
653
        push @columns, $column_quote;
654
        push @placeholders, ":$column";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
655
    }
656
    
cleanup
Yuki Kimoto authored on 2011-04-02
657
    return '(' . join(', ', @columns) . ') ' . 'values ' .
658
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
659
}
660

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
661
sub include_model {
662
    my ($self, $name_space, $model_infos) = @_;
663
    
cleanup
Yuki Kimoto authored on 2011-04-02
664
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
665
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
666
    
667
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
668
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
669

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
670
        # Load name space module
cleanup
Yuki Kimoto authored on 2011-04-25
671
        croak qq{"$name_space" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
672
          if $name_space =~ /[^\w:]/;
673
        eval "use $name_space";
cleanup
Yuki Kimoto authored on 2011-04-25
674
        croak qq{Name space module "$name_space.pm" is needed. $@ }
675
            . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
676
          if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
677
        
678
        # Search model modules
679
        my $path = $INC{"$name_space.pm"};
680
        $path =~ s/\.pm$//;
681
        opendir my $dh, $path
cleanup
Yuki Kimoto authored on 2011-04-25
682
          or croak qq{Can't open directory "$path": $! } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
683
        $model_infos = [];
684
        while (my $module = readdir $dh) {
685
            push @$model_infos, $module
686
              if $module =~ s/\.pm$//;
687
        }
688
        close $dh;
689
    }
690
    
cleanup
Yuki Kimoto authored on 2011-04-02
691
    # Include models
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
692
    foreach my $model_info (@$model_infos) {
693
        
cleanup
Yuki Kimoto authored on 2011-04-02
694
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
695
        my $model_class;
696
        my $model_name;
697
        my $model_table;
698
        if (ref $model_info eq 'HASH') {
699
            $model_class = $model_info->{class};
700
            $model_name  = $model_info->{name};
701
            $model_table = $model_info->{table};
702
            
703
            $model_name  ||= $model_class;
704
            $model_table ||= $model_name;
705
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
706
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
707
        my $mclass = "${name_space}::$model_class";
cleanup
Yuki Kimoto authored on 2011-04-25
708
        croak qq{"$mclass" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
709
          if $mclass =~ /[^\w:]/;
710
        unless ($mclass->can('isa')) {
711
            eval "use $mclass";
cleanup
Yuki Kimoto authored on 2011-04-25
712
            croak "$@ " . _subname if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
713
        }
714
        
cleanup
Yuki Kimoto authored on 2011-04-02
715
        # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
716
        my $args = {};
717
        $args->{model_class} = $mclass if $mclass;
718
        $args->{name}        = $model_name if $model_name;
719
        $args->{table}       = $model_table if $model_table;
720
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
721
    }
722
    
723
    return $self;
724
}
725

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
726
sub merge_param {
727
    my ($self, @params) = @_;
728
    
cleanup
Yuki Kimoto authored on 2011-04-02
729
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
730
    my $merge = {};
731
    foreach my $param (@params) {
732
        foreach my $column (keys %$param) {
733
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
734
            
735
            if (exists $merge->{$column}) {
736
                $merge->{$column} = [$merge->{$column}]
737
                  unless ref $merge->{$column} eq 'ARRAY';
738
                push @{$merge->{$column}},
739
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
740
            }
741
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
742
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
743
            }
744
        }
745
    }
746
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
747
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
748
}
749

            
cleanup
Yuki Kimoto authored on 2011-03-21
750
sub method {
751
    my $self = shift;
752
    
cleanup
Yuki Kimoto authored on 2011-04-02
753
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
754
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
755
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
756
    
757
    return $self;
758
}
759

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
760
sub model {
761
    my ($self, $name, $model) = @_;
762
    
cleanup
Yuki Kimoto authored on 2011-04-02
763
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
764
    if ($model) {
765
        $self->models->{$name} = $model;
766
        return $self;
767
    }
768
    
769
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
770
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
771
      unless $self->models->{$name};
772
    
cleanup
Yuki Kimoto authored on 2011-04-02
773
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
774
    return $self->models->{$name};
775
}
776

            
cleanup
Yuki Kimoto authored on 2011-03-21
777
sub mycolumn {
778
    my ($self, $table, $columns) = @_;
779
    
cleanup
Yuki Kimoto authored on 2011-04-02
780
    # Create column clause
781
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
782
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
783
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
784
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
785
    
786
    return join (', ', @column);
787
}
788

            
added dbi_options attribute
kimoto authored on 2010-12-20
789
sub new {
790
    my $self = shift->SUPER::new(@_);
791
    
cleanup
Yuki Kimoto authored on 2011-04-02
792
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
793
    my @attrs = keys %$self;
794
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
795
        croak qq{"$attr" is wrong name } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
796
          unless $self->can($attr);
797
    }
cleanup
Yuki Kimoto authored on 2011-04-02
798
    
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
799
    # DEPRECATED!
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
800
    $self->query_builder->{tags} = {
cleanup
Yuki Kimoto authored on 2011-01-25
801
        '?'     => \&DBIx::Custom::Tag::placeholder,
802
        '='     => \&DBIx::Custom::Tag::equal,
803
        '<>'    => \&DBIx::Custom::Tag::not_equal,
804
        '>'     => \&DBIx::Custom::Tag::greater_than,
805
        '<'     => \&DBIx::Custom::Tag::lower_than,
806
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
807
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
808
        'like'  => \&DBIx::Custom::Tag::like,
809
        'in'    => \&DBIx::Custom::Tag::in,
810
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
811
        'update_param' => \&DBIx::Custom::Tag::update_param
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
812
    };
added dbi_options attribute
kimoto authored on 2010-12-20
813
    
814
    return $self;
815
}
816

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

            
cleanup
yuki-kimoto authored on 2010-10-17
819
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
820
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
821
    
822
    # Register filter
823
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
824
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
825
    
cleanup
Yuki Kimoto authored on 2011-04-02
826
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
827
}
packaging one directory
yuki-kimoto authored on 2009-11-16
828

            
cleanup
Yuki Kimoto authored on 2011-03-21
829
our %SELECT_ARGS
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
830
  = map { $_ => 1 } @COMMON_ARGS,
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
831
                    qw/column where relation join param where_param wrap/;
refactoring select
yuki-kimoto authored on 2010-04-28
832

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
836
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
837
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
838
    my $tables = ref $table eq 'ARRAY' ? $table
839
               : defined $table ? [$table]
840
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
841
    my $columns   = delete $args{column};
842
    my $where     = delete $args{where} || {};
843
    my $append    = delete $args{append};
844
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
845
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
846
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
847
    my $relation = delete $args{relation};
added warnings
Yuki Kimoto authored on 2011-06-07
848
    warn "select() relation option is DEPRECATED! use join option instead"
849
      if $relation;
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
850
    my $param = delete $args{param} || {}; # DEPRECATED!
added warnings
Yuki Kimoto authored on 2011-06-07
851
    warn "select() param option is DEPRECATED! use where_param option instead"
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
852
      if keys %$param;
853
    my $where_param = delete $args{where_param} || $param || {};
cleanup
Yuki Kimoto authored on 2011-04-02
854
    my $query_return = $args{query};
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
855
    my $wrap = delete $args{wrap};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
856
    my $id = delete $args{id};
857
    my $primary_key = delete $args{primary_key};
858
    croak "update method primary_key option " .
859
          "must be specified when id is specified " . _subname
860
      if defined $id && !defined $primary_key;
861
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
862
    
cleanup
Yuki Kimoto authored on 2011-04-02
863
    # Check arguments
864
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
865
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
866
          unless $SELECT_ARGS{$name};
867
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
868
    
cleanup
Yuki Kimoto authored on 2011-03-09
869
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
870
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
871
    
cleanup
Yuki Kimoto authored on 2011-04-02
872
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
873
    my @sql;
874
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
875
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
876
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
877
    if ($columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-07
878
        $columns = [$columns] unless ref $columns eq 'ARRAY';
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
879
        foreach my $column (@$columns) {
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
880
            $column = $self->col(%$column) if ref $column eq 'HASH';
cleanup
Yuki Kimoto authored on 2011-04-02
881
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
882
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
883
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
884
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
885
    }
886
    else { push @sql, '*' }
887
    
888
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
889
    push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-04-02
890
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-30
891
    if ($relation) {
892
        my $found = {};
893
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
894
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
895
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
896
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
897
    }
cleanup
Yuki Kimoto authored on 2011-03-30
898
    else {
899
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
900
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
901
    }
902
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
903
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
904
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
905

            
cleanup
Yuki Kimoto authored on 2011-04-02
906
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
907
    unshift @$tables,
908
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
909
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
910
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
911
    my $where_clause = '';
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
912
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
cleanup
Yuki Kimoto authored on 2011-04-25
913
    if (ref $where) {
914
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
915
        $where_param = keys %$where_param
916
                     ? $self->merge_param($where_param, $where->param)
917
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
918
        
919
        # String where
920
        $where_clause = $where->to_string;
921
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
922
    elsif ($where) { $where_clause = "where $where" }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
923
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
924
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
925
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
926
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
927
    # Push join
928
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
929
    
cleanup
Yuki Kimoto authored on 2011-03-09
930
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
931
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
932
    
cleanup
Yuki Kimoto authored on 2011-03-08
933
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
934
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
935
    
cleanup
Yuki Kimoto authored on 2011-04-02
936
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
937
    push @sql, $append if $append;
938
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
939
    # Wrap
940
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
941
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
942
          unless ref $wrap eq 'ARRAY';
943
        unshift @sql, $wrap->[0];
944
        push @sql, $wrap->[1];
945
    }
946
    
cleanup
Yuki Kimoto authored on 2011-01-27
947
    # SQL
948
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
949
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
950
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
951
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
952
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
953
    
packaging one directory
yuki-kimoto authored on 2009-11-16
954
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
955
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
956
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
957
        param => $where_param, 
cleanup
Yuki Kimoto authored on 2011-03-21
958
        table => $tables,
959
        %args
960
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
961
    
962
    return $result;
963
}
964

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
965
sub setup_model {
966
    my $self = shift;
967
    
cleanup
Yuki Kimoto authored on 2011-04-02
968
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
969
    $self->each_column(
970
        sub {
971
            my ($self, $table, $column, $column_info) = @_;
972
            if (my $model = $self->models->{$table}) {
973
                push @{$model->columns}, $column;
974
            }
975
        }
976
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
977
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
978
}
979

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
986
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
987
    my $param;
988
    $param = shift if @_ % 2;
989
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
990
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
991
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
992
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
993
    my $p = delete $args{param} || {};
994
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
995
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
996
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
997
    my $append           = delete $args{append} || '';
998
    my $allow_update_all = delete $args{allow_update_all};
cleanup
Yuki Kimoto authored on 2011-06-08
999
    my $id = delete $args{id};
1000
    my $primary_key = delete $args{primary_key};
1001
    croak "update method primary_key option " .
1002
          "must be specified when id is specified " . _subname
1003
      if defined $id && !defined $primary_key;
1004
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
version 0.0901
yuki-kimoto authored on 2009-12-17
1005
    
cleanup
Yuki Kimoto authored on 2011-04-02
1006
    # Check argument names
1007
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1008
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1009
          unless $UPDATE_ARGS{$name};
1010
    }
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1011

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

            
1015
    # Where
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1016
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1017
    my $where_clause = '';
1018
    if (ref $where) {
1019
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1020
        $where_param = keys %$where_param
1021
                     ? $self->merge_param($where_param, $where->param)
1022
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1023
        
1024
        # String where
1025
        $where_clause = $where->to_string;
1026
    }
1027
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1028
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1029
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1030
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1031
    # Merge param
1032
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1033
    
cleanup
Yuki Kimoto authored on 2011-04-02
1034
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1035
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1036
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
1037
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1038
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1039
    
cleanup
Yuki Kimoto authored on 2011-01-27
1040
    # SQL
1041
    my $sql = join(' ', @sql);
1042
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1043
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1044
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1045
    return $query if $args{query};
1046
    
cleanup
yuki-kimoto authored on 2010-10-17
1047
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1048
    my $ret_val = $self->execute(
1049
        $query,
1050
        param  => $param, 
1051
        table => $table,
1052
        %args
1053
    );
cleanup
yuki-kimoto authored on 2010-10-17
1054
    
1055
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1056
}
1057

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1060
sub update_param {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1061
    my ($self, $param, $opt) = @_;
1062
    
cleanup
Yuki Kimoto authored on 2011-04-02
1063
    # Create update parameter tag
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1064
    my $tag = $self->assign_param($param);
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1065
    $tag = "set $tag" unless $opt->{no_set};
1066

            
cleanup
Yuki Kimoto authored on 2011-04-02
1067
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1068
}
1069

            
cleanup
Yuki Kimoto authored on 2011-01-25
1070
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1071
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1072
    
1073
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1074
    return DBIx::Custom::Where->new(
1075
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1076
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1077
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1078
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1079
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1080
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1081

            
cleanup
Yuki Kimoto authored on 2011-04-02
1082
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1083
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1084
    
cleanup
Yuki Kimoto authored on 2011-04-02
1085
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1086
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1087
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1088
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1089
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1090
        
1091
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1092
        my $value;
1093
        if(ref $params->{$column} eq 'ARRAY') {
1094
            my $i = $count->{$column} || 0;
1095
            $i += $not_exists->{$column} || 0;
1096
            my $found;
1097
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1098
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1099
                    $not_exists->{$column}++;
1100
                }
1101
                else  {
1102
                    $value = $params->{$column}->[$k];
1103
                    $found = 1;
1104
                    last
1105
                }
1106
            }
1107
            next unless $found;
1108
        }
1109
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1110
        
cleanup
Yuki Kimoto authored on 2011-01-12
1111
        # Filter
1112
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1113
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1114
        # Type
1115
        push @$bind, {
1116
            value => $f ? $f->($value) : $value,
1117
            type => $type->{$column}
1118
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1119
        
1120
        # Count up 
1121
        $count->{$column}++;
1122
    }
1123
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1124
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1125
}
1126

            
cleanup
Yuki Kimoto authored on 2011-06-08
1127
sub _create_param_from_id {
1128
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1129
    
cleanup
Yuki Kimoto authored on 2011-06-08
1130
    # Create parameter
1131
    my $param = {};
1132
    if ($id) {
1133
        $id = [$id] unless ref $id;
1134
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1135
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1136
          unless !ref $id || ref $id eq 'ARRAY';
1137
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1138
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1139
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1140
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1141
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1142
        }
1143
    }
1144
    
cleanup
Yuki Kimoto authored on 2011-06-08
1145
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1146
}
1147

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1148
sub _connect {
1149
    my $self = shift;
1150
    
1151
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1152
    my $dsn = $self->data_source;
1153
    warn "data_source is DEPRECATED! use dsn instead\n";
1154
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1155
    croak qq{"dsn" must be specified } . _subname
1156
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1157
    my $user        = $self->user;
1158
    my $password    = $self->password;
1159
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1160
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1161
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1162
    
1163
    # Connect
1164
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1165
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1166
        $user,
1167
        $password,
1168
        {
1169
            %{$self->default_dbi_option},
1170
            %$dbi_option
1171
        }
1172
    )};
1173
    
1174
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1175
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1176
    
1177
    return $dbh;
1178
}
1179

            
cleanup
yuki-kimoto authored on 2010-10-17
1180
sub _croak {
1181
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1182
    
1183
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1184
    $append ||= "";
1185
    
1186
    # Verbose
1187
    if ($Carp::Verbose) { croak $error }
1188
    
1189
    # Not verbose
1190
    else {
1191
        
1192
        # Remove line and module infromation
1193
        my $at_pos = rindex($error, ' at ');
1194
        $error = substr($error, 0, $at_pos);
1195
        $error =~ s/\s+$//;
1196
        croak "$error$append";
1197
    }
1198
}
1199

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1200
sub _need_tables {
1201
    my ($self, $tree, $need_tables, $tables) = @_;
1202
    
cleanup
Yuki Kimoto authored on 2011-04-02
1203
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1204
    foreach my $table (@$tables) {
1205
        if ($tree->{$table}) {
1206
            $need_tables->{$table} = 1;
1207
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1208
        }
1209
    }
1210
}
1211

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1212
sub _push_join {
1213
    my ($self, $sql, $join, $join_tables) = @_;
1214
    
cleanup
Yuki Kimoto authored on 2011-04-02
1215
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1216
    return unless @$join;
1217
    
cleanup
Yuki Kimoto authored on 2011-04-02
1218
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1219
    my $tree = {};
cleanup
Yuki Kimoto authored on 2011-04-02
1220
    my $q = $self->reserved_word_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1221
    for (my $i = 0; $i < @$join; $i++) {
1222
        
cleanup
Yuki Kimoto authored on 2011-04-02
1223
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1224
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1225
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1226
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1227
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1228
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1229
            my $table1 = $1;
1230
            my $table2 = $2;
cleanup
Yuki Kimoto authored on 2011-04-25
1231
            croak qq{right side table of "$join_clause" must be unique }
1232
                . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1233
              if exists $tree->{$table2};
1234
            $tree->{$table2}
1235
              = {position => $i, parent => $table1, join => $join_clause};
1236
        }
1237
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
1238
            croak qq{join "$join_clause" must be two table name } . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1239
        }
1240
    }
1241
    
cleanup
Yuki Kimoto authored on 2011-04-02
1242
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1243
    my $need_tables = {};
1244
    $self->_need_tables($tree, $need_tables, $join_tables);
1245
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1246
    
1247
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1248
    foreach my $need_table (@need_tables) {
1249
        push @$sql, $tree->{$need_table}{join};
1250
    }
1251
}
cleanup
Yuki Kimoto authored on 2011-03-08
1252

            
cleanup
Yuki Kimoto authored on 2011-04-02
1253
sub _remove_duplicate_table {
1254
    my ($self, $tables, $main_table) = @_;
1255
    
1256
    # Remove duplicate table
1257
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1258
    delete $tables{$main_table} if $main_table;
1259
    
1260
    return [keys %tables, $main_table ? $main_table : ()];
1261
}
1262

            
cleanup
Yuki Kimoto authored on 2011-04-02
1263
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1264
    my ($self, $source) = @_;
1265
    
cleanup
Yuki Kimoto authored on 2011-04-02
1266
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1267
    my $tables = [];
1268
    my $safety_character = $self->safety_character;
1269
    my $q = $self->reserved_word_quote;
1270
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1271
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1272
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1273
    while ($source =~ /$table_re/g) {
1274
        push @$tables, $1;
1275
    }
1276
    
1277
    return $tables;
1278
}
1279

            
cleanup
Yuki Kimoto authored on 2011-04-02
1280
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1281
    my ($self, $where) = @_;
1282
    
cleanup
Yuki Kimoto authored on 2011-04-02
1283
    my $obj;
1284
    
1285
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1286
    if (ref $where eq 'HASH') {
1287
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1288
        my $q = $self->reserved_word_quote;
1289
        foreach my $column (keys %$where) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1290
            my $column_quote = "$q$column$q";
1291
            $column_quote =~ s/\./$q.$q/;
1292
            push @$clause, "$column_quote = :$column" for keys %$where;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1293
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1294
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1295
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1296
    
1297
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1298
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1299
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1300
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1301
    
1302
    # Array(DEPRECATED!)
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1303
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1304
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1305
             "use \$dbi->select(where => \$dbi->where(clause => " .
added warnings
Yuki Kimoto authored on 2011-06-07
1306
             "CLAUSE, where_param => PARAMETER));";
cleanup
Yuki Kimoto authored on 2011-04-02
1307
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1308
            clause => $where->[0],
1309
            param  => $where->[1]
1310
        );
1311
    }
1312
    
cleanup
Yuki Kimoto authored on 2011-04-02
1313
    # Check where argument
improved error messages
Yuki Kimoto authored on 2011-04-18
1314
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1315
        . qq{or array reference, which contains where clause and paramter}
cleanup
Yuki Kimoto authored on 2011-04-25
1316
        . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1317
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1318
    
cleanup
Yuki Kimoto authored on 2011-04-02
1319
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1320
}
1321

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1322
# DEPRECATED!
1323
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
1324
sub select_at {
1325
    my ($self, %args) = @_;
1326

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1329
    # Arguments
1330
    my $primary_keys = delete $args{primary_key};
1331
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1332
    my $where = delete $args{where};
1333
    my $param = delete $args{param};
1334
    
1335
    # Check arguments
1336
    foreach my $name (keys %args) {
1337
        croak qq{"$name" is wrong option } . _subname
1338
          unless $SELECT_AT_ARGS{$name};
1339
    }
1340
    
1341
    # Table
1342
    croak qq{"table" option must be specified } . _subname
1343
      unless $args{table};
1344
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1345
    
1346
    # Create where parameter
1347
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1348
    
1349
    return $self->select(where => $where_param, %args);
1350
}
1351

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1352
# DEPRECATED!
1353
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1354
sub delete_at {
1355
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1356

            
1357
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1358
    
1359
    # Arguments
1360
    my $primary_keys = delete $args{primary_key};
1361
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1362
    my $where = delete $args{where};
1363
    
1364
    # Check arguments
1365
    foreach my $name (keys %args) {
1366
        croak qq{"$name" is wrong option } . _subname
1367
          unless $DELETE_AT_ARGS{$name};
1368
    }
1369
    
1370
    # Create where parameter
1371
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1372
    
1373
    return $self->delete(where => $where_param, %args);
1374
}
1375

            
cleanup
Yuki Kimoto authored on 2011-06-08
1376
# DEPRECATED!
1377
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1378
sub update_at {
1379
    my $self = shift;
1380

            
1381
    warn "update_at is DEPRECATED! use update and id option instead";
1382
    
1383
    # Arguments
1384
    my $param;
1385
    $param = shift if @_ % 2;
1386
    my %args = @_;
1387
    my $primary_keys = delete $args{primary_key};
1388
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1389
    my $where = delete $args{where};
1390
    my $p = delete $args{param} || {};
1391
    $param  ||= $p;
1392
    
1393
    # Check arguments
1394
    foreach my $name (keys %args) {
1395
        croak qq{"$name" is wrong option } . _subname
1396
          unless $UPDATE_AT_ARGS{$name};
1397
    }
1398
    
1399
    # Create where parameter
1400
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1401
    
1402
    return $self->update(where => $where_param, param => $param, %args);
1403
}
1404

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1405
# DEPRECATED!
1406
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
1407
sub insert_at {
1408
    my $self = shift;
1409
    
1410
    warn "insert_at is DEPRECATED! use insert and id option instead";
1411
    
1412
    # Arguments
1413
    my $param;
1414
    $param = shift if @_ % 2;
1415
    my %args = @_;
1416
    my $primary_key = delete $args{primary_key};
1417
    $primary_key = [$primary_key] unless ref $primary_key;
1418
    my $where = delete $args{where};
1419
    my $p = delete $args{param} || {};
1420
    $param  ||= $p;
1421
    
1422
    # Check arguments
1423
    foreach my $name (keys %args) {
1424
        croak qq{"$name" is wrong option } . _subname
1425
          unless $INSERT_AT_ARGS{$name};
1426
    }
1427
    
1428
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1429
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1430
    $param = $self->merge_param($where_param, $param);
1431
    
1432
    return $self->insert(param => $param, %args);
1433
}
1434

            
added warnings
Yuki Kimoto authored on 2011-06-07
1435
# DEPRECATED!
1436
sub register_tag {
1437
    warn "register_tag is DEPRECATED!";
1438
    shift->query_builder->register_tag(@_)
1439
}
1440

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1441
# DEPRECATED!
1442
__PACKAGE__->attr('data_source');
1443

            
cleanup
Yuki Kimoto authored on 2011-01-25
1444
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1445
__PACKAGE__->attr(
1446
    dbi_options => sub { {} },
1447
    filter_check  => 1
1448
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1449

            
cleanup
Yuki Kimoto authored on 2011-01-25
1450
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1451
sub default_bind_filter {
1452
    my $self = shift;
1453
    
added warnings
Yuki Kimoto authored on 2011-06-07
1454
    warn "default_bind_filter is DEPRECATED! use apply_filter instead\n";
1455
    
cleanup
Yuki Kimoto authored on 2011-01-12
1456
    if (@_) {
1457
        my $fname = $_[0];
1458
        
1459
        if (@_ && !$fname) {
1460
            $self->{default_out_filter} = undef;
1461
        }
1462
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1463
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1464
              unless exists $self->filters->{$fname};
1465
        
1466
            $self->{default_out_filter} = $self->filters->{$fname};
1467
        }
1468
        return $self;
1469
    }
1470
    
1471
    return $self->{default_out_filter};
1472
}
1473

            
cleanup
Yuki Kimoto authored on 2011-01-25
1474
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1475
sub default_fetch_filter {
1476
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1477

            
1478
    warn "default_fetch_filter is DEPRECATED! use apply_filter instead\n";
cleanup
Yuki Kimoto authored on 2011-01-12
1479
    
1480
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1481
        my $fname = $_[0];
1482

            
cleanup
Yuki Kimoto authored on 2011-01-12
1483
        if (@_ && !$fname) {
1484
            $self->{default_in_filter} = undef;
1485
        }
1486
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1487
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1488
              unless exists $self->filters->{$fname};
1489
        
1490
            $self->{default_in_filter} = $self->filters->{$fname};
1491
        }
1492
        
1493
        return $self;
1494
    }
1495
    
many changed
Yuki Kimoto authored on 2011-01-23
1496
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1497
}
1498

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1499
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1500
sub insert_param_tag {
1501
    warn "insert_param_tag is DEPRECATED! " .
1502
         "use insert_param instead!";
1503
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1504
}
1505

            
cleanup
Yuki Kimoto authored on 2011-01-25
1506
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1507
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1508
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1509
    return shift->query_builder->register_tag_processor(@_);
1510
}
1511

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1512
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1513
sub update_param_tag {
1514
    warn "update_param is DEPRECATED! " .
1515
         "use update_param instead";
1516
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1517
}
cleanup
Yuki Kimoto authored on 2011-03-08
1518
# DEPRECATED!
1519
sub _push_relation {
1520
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1521
    
1522
    if (keys %{$relation || {}}) {
1523
        push @$sql, $need_where ? 'where' : 'and';
1524
        foreach my $rcolumn (keys %$relation) {
1525
            my $table1 = (split (/\./, $rcolumn))[0];
1526
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1527
            push @$tables, ($table1, $table2);
1528
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1529
        }
1530
    }
1531
    pop @$sql if $sql->[-1] eq 'and';    
1532
}
1533

            
1534
# DEPRECATED!
1535
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1536
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1537
    
1538
    if (keys %{$relation || {}}) {
1539
        foreach my $rcolumn (keys %$relation) {
1540
            my $table1 = (split (/\./, $rcolumn))[0];
1541
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1542
            my $table1_exists;
1543
            my $table2_exists;
1544
            foreach my $table (@$tables) {
1545
                $table1_exists = 1 if $table eq $table1;
1546
                $table2_exists = 1 if $table eq $table2;
1547
            }
1548
            unshift @$tables, $table1 unless $table1_exists;
1549
            unshift @$tables, $table2 unless $table2_exists;
1550
        }
1551
    }
1552
}
1553

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

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

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

            
1560
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1561

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1562
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1563
    
1564
    # Connect
1565
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1566
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1567
        user => 'ken',
1568
        password => '!LFKD%$&',
1569
        dbi_option => {mysql_enable_utf8 => 1}
1570
    );
cleanup
yuki-kimoto authored on 2010-08-05
1571

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1572
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1573
    $dbi->insert(
1574
        table  => 'book',
1575
        param  => {title => 'Perl', author => 'Ken'}
1576
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1577
    
1578
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1579
    $dbi->update(
1580
        table  => 'book', 
1581
        param  => {title => 'Perl', author => 'Ken'}, 
1582
        where  => {id => 5},
1583
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1584
    
1585
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1586
    $dbi->delete(
1587
        table  => 'book',
1588
        where  => {author => 'Ken'},
1589
    );
cleanup
yuki-kimoto authored on 2010-08-05
1590

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1597
    # Select, more complex
1598
    my $result = $dbi->select(
1599
        table  => 'book',
1600
        column => [
1601
            'book.author as book__author',
1602
            'company.name as company__name'
1603
        ],
1604
        where  => {'book.author' => 'Ken'},
1605
        join => ['left outer join company on book.company_id = company.id'],
1606
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1607
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1608
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1609
    # Fetch
1610
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1611
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1612
    }
1613
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1614
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1615
    while (my $row = $result->fetch_hash) {
1616
        
1617
    }
1618
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1619
    # Execute SQL with parameter.
1620
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1621
        "select id from book where author = :author and title like :title",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1622
        param  => {author => 'ken', title => '%Perl%'}
1623
    );
1624
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1625
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1626

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

            
1629
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1630

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1635
There are many basic methods to execute various queries.
1636
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1637
C<delete_all()>, C<select()>,
1638
C<insert_at()>, C<update_at()>, 
1639
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1640

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1641
=item *
1642

            
1643
Filter when data is send or receive.
1644

            
1645
=item *
1646

            
1647
Data filtering system
1648

            
1649
=item *
1650

            
1651
Model support.
1652

            
1653
=item *
1654

            
1655
Generate where clause dinamically.
1656

            
1657
=item *
1658

            
1659
Generate join clause dinamically.
1660

            
1661
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1662

            
1663
=head1 GUIDE
1664

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

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

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

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

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

            
1675
    my $connector = $dbi->connector;
1676
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1677

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

            
1681
This is L<DBIx::Connector> example. Please pass
1682
C<default_dbi_option> to L<DBIx::Connector>.
1683

            
1684
    my $connector = DBIx::Connector->new(
1685
        "dbi:mysql:database=$DATABASE",
1686
        $USER,
1687
        $PASSWORD,
1688
        DBIx::Custom->new->default_dbi_option
1689
    );
1690
    
1691
    my $dbi = DBIx::Custom->new(connector => $connector);
1692

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

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

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

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

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

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

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

            
1710
=head2 C<default_dbi_option>
1711

            
1712
    my $default_dbi_option = $dbi->default_dbi_option;
1713
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1714

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1718
    {
1719
        RaiseError => 1,
1720
        PrintError => 0,
1721
        AutoCommit => 1,
1722
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1723

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

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

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

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

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

            
1736
    my $models = $dbi->models;
1737
    $dbi       = $dbi->models(\%models);
1738

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1741
=head2 C<password>
1742

            
1743
    my $password = $dbi->password;
1744
    $dbi         = $dbi->password('lkj&le`@s');
1745

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

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

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

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

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

            
1757
     my reserved_word_quote = $dbi->reserved_word_quote;
1758
     $dbi                   = $dbi->reserved_word_quote('"');
1759

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1779
    my $user = $dbi->user;
1780
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1781

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1792
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1793
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1794
        'issue_date' => {
1795
            out => 'tp_to_date',
1796
            in  => 'date_to_tp',
1797
            end => 'tp_to_displaydate'
1798
        },
1799
        'write_date' => {
1800
            out => 'tp_to_date',
1801
            in  => 'date_to_tp',
1802
            end => 'tp_to_displaydate'
1803
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1804
    );
1805

            
update pod
Yuki Kimoto authored on 2011-03-13
1806
Apply filter to columns.
1807
C<out> filter is executed before data is send to database.
1808
C<in> filter is executed after a row is fetch.
1809
C<end> filter is execute after C<in> filter is executed.
1810

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1813
       PETTERN         EXAMPLE
1814
    1. Column        : author
1815
    2. Table.Column  : book.author
1816
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1817

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

            
1821
You can set multiple filters at once.
1822

            
1823
    $dbi->apply_filter(
1824
        'book',
1825
        [qw/issue_date write_date/] => {
1826
            out => 'tp_to_date',
1827
            in  => 'date_to_tp',
1828
            end => 'tp_to_displaydate'
1829
        }
1830
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1831

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

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

            
1836
Create assign tag.
1837

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

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

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

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

            
1846
Create column clause. The follwoing column clause is created.
1847

            
1848
    book.author as "book.author",
1849
    book.title as "book.title"
1850

            
1851
=head2 C<column> EXPERIMETNAL
1852

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

            
1855
Create column clause. The follwoing column clause is created.
1856

            
1857
    book.author as book__author,
1858
    book.title as book__title
1859

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1862
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1863
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1864
        user => 'ken',
1865
        password => '!LFKD%$&',
1866
        dbi_option => {mysql_enable_utf8 => 1}
1867
    );
1868

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1877
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1878
        table => 'book',
1879
        primary_key => 'id',
1880
        join => [
1881
            'inner join company on book.comparny_id = company.id'
1882
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1883
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1884
            publish_date => {
1885
                out => 'tp_to_date',
1886
                in => 'date_to_tp',
1887
                end => 'tp_to_displaydate'
1888
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1889
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1890
    );
1891

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

            
1895
   $dbi->model('book')->select(...);
1896

            
cleanup
yuki-kimoto authored on 2010-10-17
1897
=head2 C<create_query>
1898
    
1899
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1900
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1901
    );
update document
yuki-kimoto authored on 2009-11-19
1902

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

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

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

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

            
1913
    my $dbh = $dbi->dbh;
1914

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

            
1918
=head2 C<each_column>
1919

            
1920
    $dbi->each_column(
1921
        sub {
1922
            my ($dbi, $table, $column, $column_info) = @_;
1923
            
1924
            my $type = $column_info->{TYPE_NAME};
1925
            
1926
            if ($type eq 'DATE') {
1927
                # ...
1928
            }
1929
        }
1930
    );
1931

            
1932
Iterate all column informations of all table from database.
1933
Argument is callback when one column is found.
1934
Callback receive four arguments, dbi object, table name,
1935
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1936

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1939
    my $result = $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1940
        "select * from book where title = :title and author like :author",
update pod
Yuki Kimoto authored on 2011-03-13
1941
        param => {title => 'Perl', author => '%Ken%'}
1942
    );
1943

            
1944
Execute SQL, containing tags.
1945
Return value is L<DBIx::Custom::Result> in select statement, or
1946
the count of affected rows in insert, update, delete statement.
1947

            
1948
Tag is turned into the statement containing place holder
1949
before SQL is executed.
1950

            
1951
    select * from where title = ? and author like ?;
1952

            
1953
See also L<Tags/Tags>.
1954

            
1955
The following opitons are currently available.
1956

            
1957
=over 4
1958

            
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1959
=item C<table>
1960

            
1961
Table names for filtering.
1962

            
1963
    $dbi->execute(table => ['author', 'book']);
1964

            
1965
C<execute()> is unlike C<insert()>, C<update()>, C<delete()>, C<select(),
1966
Filtering is off because we don't know what filter is applied.
1967

            
1968

            
1969

            
1970

            
1971

            
1972

            
update pod
Yuki Kimoto authored on 2011-03-13
1973
=item C<filter>
1974

            
1975
Filter, executed before data is send to database. This is array reference.
1976
Filter value is code reference or
1977
filter name registerd by C<register_filter()>.
1978

            
1979
    # Basic
1980
    $dbi->execute(
1981
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1982
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1983
            title  => sub { uc $_[0] }
1984
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1985
        }
update pod
Yuki Kimoto authored on 2011-03-13
1986
    );
1987
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1988
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1989
    $dbi->execute(
1990
        $sql,
1991
        filter => [
1992
            [qw/title author/]  => sub { uc $_[0] }
1993
        ]
1994
    );
1995
    
1996
    # Filter name
1997
    $dbi->execute(
1998
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1999
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2000
            title  => 'upper_case',
2001
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2002
        }
update pod
Yuki Kimoto authored on 2011-03-13
2003
    );
2004

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

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

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

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

            
2013
Delete statement.
2014

            
2015
The following opitons are currently available.
2016

            
update pod
Yuki Kimoto authored on 2011-03-13
2017
=over 4
2018

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

            
2021
Table name.
2022

            
2023
    $dbi->delete(table => 'book');
2024

            
2025
=item C<where>
2026

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2027
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2028
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
2029
    
2030
    # Hash reference
2031
    $dbi->delete(where => {title => 'Perl'});
2032
    
2033
    # DBIx::Custom::Where object
2034
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2035
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2036
        param  => {author => 'Ken', title => '%Perl%'}
2037
    );
2038
    $dbi->delete(where => $where);
2039

            
updated pod
Yuki Kimoto authored on 2011-04-25
2040
    # String(with where_param option)
2041
    $dbi->delete(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2042
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2043
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2044
    );
2045
    
update pod
Yuki Kimoto authored on 2011-03-13
2046
=item C<append>
2047

            
2048
Append statement to last of SQL. This is string.
2049

            
2050
    $dbi->delete(append => 'order by title');
2051

            
2052
=item C<filter>
2053

            
2054
Filter, executed before data is send to database. This is array reference.
2055
Filter value is code reference or
2056
filter name registerd by C<register_filter()>.
2057

            
2058
    # Basic
2059
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2060
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2061
            title  => sub { uc $_[0] }
2062
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2063
        }
update pod
Yuki Kimoto authored on 2011-03-13
2064
    );
2065
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2066
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2067
    $dbi->delete(
2068
        filter => [
2069
            [qw/title author/]  => sub { uc $_[0] }
2070
        ]
2071
    );
2072
    
2073
    # Filter name
2074
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2075
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2076
            title  => 'upper_case',
2077
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2078
        }
update pod
Yuki Kimoto authored on 2011-03-13
2079
    );
2080

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

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

            
2085
Get L<DBIx::Custom::Query> object instead of executing SQL.
2086
This is true or false value.
2087

            
2088
    my $query = $dbi->delete(query => 1);
2089

            
2090
You can check SQL.
2091

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2094
=item C<id>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2095

            
updated pod
Yuki Kimoto authored on 2011-06-08
2096
Delete using primary_key.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2097

            
updated pod
Yuki Kimoto authored on 2011-06-08
2098
    $dbi->delete(
update pod
Yuki Kimoto authored on 2011-03-13
2099
        primary_key => 'id',
updated pod
Yuki Kimoto authored on 2011-06-08
2100
        id => 4,
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2101
    );
2102

            
updated pod
Yuki Kimoto authored on 2011-06-08
2103
    $dbi->delete(
2104
        primary_key => ['id1', 'id2'],
2105
        id => [4, 5],
2106
    );
update pod
Yuki Kimoto authored on 2011-03-13
2107

            
updated pod
Yuki Kimoto authored on 2011-06-08
2108
The above is same as the followin ones.
update pod
Yuki Kimoto authored on 2011-03-13
2109

            
updated pod
Yuki Kimoto authored on 2011-06-08
2110
    $dbi->delete(where => {id => 4});
update pod
Yuki Kimoto authored on 2011-03-13
2111

            
updated pod
Yuki Kimoto authored on 2011-06-08
2112
    $dbi->delete(where => {id1 => 4, id2 => 5});
update pod
Yuki Kimoto authored on 2011-03-13
2113

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2118
=back
update pod
Yuki Kimoto authored on 2011-03-13
2119

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2124
Delete statement to delete all rows.
2125
Options is same as C<delete()>.
update pod
Yuki Kimoto authored on 2011-03-13
2126

            
cleanup
yuki-kimoto authored on 2010-10-17
2127
=head2 C<insert>
2128

            
update pod
Yuki Kimoto authored on 2011-03-13
2129
    $dbi->insert(
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2130
        param  => {title => 'Perl', author => 'Ken'},
2131
        table  => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2132
    );
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2133
    
update pod
Yuki Kimoto authored on 2011-03-13
2134
Insert statement.
2135

            
2136
The following opitons are currently available.
2137

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

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

            
2142
Insert data. This is hash reference.
2143

            
2144
    $dbi->insert(param => {title => 'Perl'});
2145

            
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2146
If arguments is odd numbers, first argument is received as C<param>.
2147

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

            
2150
=item C<table>
2151

            
2152
Table name.
2153

            
2154
    $dbi->insert(table => 'book');
2155

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

            
2158
Append statement to last of SQL. This is string.
2159

            
2160
    $dbi->insert(append => 'order by title');
2161

            
2162
=item C<filter>
2163

            
2164
Filter, executed before data is send to database. This is array reference.
2165
Filter value is code reference or
2166
filter name registerd by C<register_filter()>.
2167

            
2168
    # Basic
2169
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2170
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2171
            title  => sub { uc $_[0] }
2172
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2173
        }
update pod
Yuki Kimoto authored on 2011-03-13
2174
    );
2175
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2176
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2177
    $dbi->insert(
2178
        filter => [
2179
            [qw/title author/]  => sub { uc $_[0] }
2180
        ]
2181
    );
2182
    
2183
    # Filter name
2184
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2185
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2186
            title  => 'upper_case',
2187
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2188
        }
update pod
Yuki Kimoto authored on 2011-03-13
2189
    );
2190

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

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

            
2195
Get L<DBIx::Custom::Query> object instead of executing SQL.
2196
This is true or false value.
2197

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2204
=back
2205

            
2206
=over 4
2207

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2223
    lib / MyModel.pm
2224
        / MyModel / book.pm
2225
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2226

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

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

            
2231
    package MyModel;
2232
    
2233
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2234
    
2235
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2236

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2241
    package MyModel::book;
2242
    
2243
    use base 'MyModel';
2244
    
2245
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2246

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2249
    package MyModel::company;
2250
    
2251
    use base 'MyModel';
2252
    
2253
    1;
2254
    
2255
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2256

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

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

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

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

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

            
2268
Merge paramters.
2269

            
2270
$param:
2271

            
2272
    {key1 => [1, 1], key2 => 2}
2273

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

            
2276
    $dbi->method(
2277
        update_or_insert => sub {
2278
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2279
            
2280
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2281
        },
2282
        find_or_create   => sub {
2283
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2284
            
2285
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2286
        }
2287
    );
2288

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

            
2291
    $dbi->update_or_insert;
2292
    $dbi->find_or_create;
2293

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

            
2296
    $dbi->model('book')->method(
2297
        insert => sub { ... },
2298
        update => sub { ... }
2299
    );
2300
    
2301
    my $model = $dbi->model('book');
2302

            
2303
Set and get a L<DBIx::Custom::Model> object,
2304

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

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

            
2309
Create column clause for myself. The follwoing column clause is created.
2310

            
2311
    book.author as author,
2312
    book.title as title
2313

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2316
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2317
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2318
        user => 'ken',
2319
        password => '!LFKD%$&',
2320
        dbi_option => {mysql_enable_utf8 => 1}
2321
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2322

            
2323
Create a new L<DBIx::Custom> object.
2324

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

            
2327
    my $not_exists = $dbi->not_exists;
2328

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2332
=head2 C<register_filter>
2333

            
update pod
Yuki Kimoto authored on 2011-03-13
2334
    $dbi->register_filter(
2335
        # Time::Piece object to database DATE format
2336
        tp_to_date => sub {
2337
            my $tp = shift;
2338
            return $tp->strftime('%Y-%m-%d');
2339
        },
2340
        # database DATE format to Time::Piece object
2341
        date_to_tp => sub {
2342
           my $date = shift;
2343
           return Time::Piece->strptime($date, '%Y-%m-%d');
2344
        }
2345
    );
cleanup
yuki-kimoto authored on 2010-10-17
2346
    
update pod
Yuki Kimoto authored on 2011-03-13
2347
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2348

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2351
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2352
        table  => 'book',
2353
        column => ['author', 'title'],
2354
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2355
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2356
    
update pod
Yuki Kimoto authored on 2011-03-12
2357
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2358

            
2359
The following opitons are currently available.
2360

            
2361
=over 4
2362

            
2363
=item C<table>
2364

            
2365
Table name.
2366

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

            
2369
=item C<column>
2370

            
2371
Column clause. This is array reference or constant value.
2372

            
updated pod
Yuki Kimoto authored on 2011-06-07
2373
    # Array reference
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2374
    $dbi->select(column => ['author', 'title']);
2375
    
2376
    # Constant value
2377
    $dbi->select(column => 'author');
updated pod
Yuki Kimoto authored on 2011-06-07
2378
    
2379
Default is '*' if C<column> is not specified.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2380

            
2381
    # Default
2382
    $dbi->select(column => '*');
2383

            
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
2384
You can specify hash reference. This is EXPERIMENTAL.
updated pod
Yuki Kimoto authored on 2011-06-07
2385

            
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
2386
    # Hash reference EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-07
2387
    $dbi->select(column => [
2388
        {book => [qw/author title/]},
2389
        {person => [qw/name age/]}
2390
    ]);
2391
    
2392
This is expanded to the following one by C<column> method automatically.
2393

            
2394
    book.author as book__author,
2395
    book.title as book__title,
2396
    person.name as person__name,
2397
    person.age as person__age
2398

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

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
2414
    # String(with where_param option)
2415
    $dbi->select(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2416
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2417
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2418
    );
2419
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2420
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2421

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

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

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

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

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

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

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

            
2453
Parameter shown before where clause.
2454
    
2455
    $dbi->select(
2456
        table => 'table1',
2457
        column => 'table1.key1 as table1_key1, key2, key3',
2458
        where   => {'table1.key2' => 3},
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2459
        join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2460
                  ' as table2 on table1.key1 = table2.key1'],
2461
        param => {'table2.key3' => 5}
2462
    );
2463

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

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

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

            
2471
    $dbi->select(append => 'order by title');
updated pod
Yuki Kimoto authored on 2011-06-08
2472
    
2473
=item C<id>
2474

            
2475
Select using primary_key.
2476

            
2477
    $dbi->select(
2478
        primary_key => 'id',
2479
        id => 4,
2480
    );
2481

            
2482
    $dbi->select(
2483
        primary_key => ['id1', 'id2'],
2484
        id => [4, 5]
2485
    );
2486

            
2487
The above is same as the followin ones.
2488

            
2489
    $dbi->insert(where => {id => 4});
2490

            
2491
    $dbi->insert(where => {id1 => 4, id2 => 5});
2492

            
2493
=item C<primary_key>
2494

            
2495
See C<id> option.
update pod
Yuki Kimoto authored on 2011-03-12
2496

            
improved pod
Yuki Kimoto authored on 2011-04-19
2497
=item C<wrap> EXPERIMENTAL
2498

            
2499
Wrap statement. This is array reference.
2500

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

            
2503
This option is for Oracle and SQL Server paging process.
2504

            
update pod
Yuki Kimoto authored on 2011-03-12
2505
=item C<filter>
2506

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

            
2511
    # Basic
2512
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2513
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2514
            title  => sub { uc $_[0] }
2515
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2516
        }
update pod
Yuki Kimoto authored on 2011-03-12
2517
    );
2518
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2519
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2520
    $dbi->select(
2521
        filter => [
2522
            [qw/title author/]  => sub { uc $_[0] }
2523
        ]
2524
    );
2525
    
2526
    # Filter name
2527
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2528
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2529
            title  => 'upper_case',
2530
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2531
        }
update pod
Yuki Kimoto authored on 2011-03-12
2532
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2533

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

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

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

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

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

            
2545
    my $sql = $query->sql;
2546

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2547
=item C<type>
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
2548

            
2549
Specify database data type.
2550

            
2551
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2552
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2553

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

            
2556
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2557

            
update pod
Yuki Kimoto authored on 2011-03-12
2558
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2559

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2562
    $dbi->update(
2563
        table  => 'book',
2564
        param  => {title => 'Perl'},
2565
        where  => {id => 4}
2566
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2567

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2572
=over 4
2573

            
2574
=item C<param>
2575

            
2576
Update data. This is hash reference.
2577

            
2578
    $dbi->update(param => {title => 'Perl'});
2579

            
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2580
If arguments is odd numbers, first argument is received as C<param>.
2581

            
2582
    $dbi->update(
2583
        {title => 'Perl'},
2584
        table => 'book',
2585
        where => {author => 'Ken'}
2586
    );
2587

            
2588
=item C<table>
2589

            
2590
Table name.
2591

            
2592
    $dbi->update(table => 'book');
2593

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2596
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2597
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2598
    
2599
    # Hash reference
2600
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2601
    
2602
    # DBIx::Custom::Where object
2603
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2604
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2605
        param  => {author => 'Ken', title => '%Perl%'}
2606
    );
2607
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2608
    
updated pod
Yuki Kimoto authored on 2011-04-25
2609
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2610
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2611
        param => {title => 'Perl'},
updated pod
Yuki Kimoto authored on 2011-06-08
2612
        where => 'id = :id',
updated pod
Yuki Kimoto authored on 2011-04-25
2613
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2614
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2615
    
update pod
Yuki Kimoto authored on 2011-03-13
2616
=item C<append>
2617

            
2618
Append statement to last of SQL. This is string.
2619

            
2620
    $dbi->update(append => 'order by title');
2621

            
2622
=item C<filter>
2623

            
2624
Filter, executed before data is send to database. This is array reference.
2625
Filter value is code reference or
2626
filter name registerd by C<register_filter()>.
2627

            
2628
    # Basic
2629
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2630
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2631
            title  => sub { uc $_[0] }
2632
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2633
        }
update pod
Yuki Kimoto authored on 2011-03-13
2634
    );
2635
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2636
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2637
    $dbi->update(
2638
        filter => [
2639
            [qw/title author/]  => sub { uc $_[0] }
2640
        ]
2641
    );
2642
    
2643
    # Filter name
2644
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2645
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2646
            title  => 'upper_case',
2647
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2648
        }
update pod
Yuki Kimoto authored on 2011-03-13
2649
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2650

            
update pod
Yuki Kimoto authored on 2011-03-13
2651
These filters are added to the C<out> filters, set by C<apply_filter()>.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2652

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

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

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

            
2660
You can check SQL.
2661

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2664
Insert using primary_key.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2665

            
updated pod
Yuki Kimoto authored on 2011-06-08
2666
    $dbi->insert(
2667
        primary_key => 'id',
2668
        id => 4,
2669
        param => {title => 'Perl', author => 'Ken'}
2670
    );
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2671

            
updated pod
Yuki Kimoto authored on 2011-06-08
2672
    $dbi->insert(
2673
        primary_key => ['id1', 'id2'],
2674
        id => [4, 5],
2675
        param => {title => 'Perl', author => 'Ken'}
2676
    );
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2677

            
updated pod
Yuki Kimoto authored on 2011-06-08
2678
The above is same as the followin ones.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2679

            
updated pod
Yuki Kimoto authored on 2011-06-08
2680
    $dbi->insert(
2681
        param => {id => 4, title => 'Perl', author => 'Ken'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2682
    );
2683

            
updated pod
Yuki Kimoto authored on 2011-06-08
2684
    $dbi->insert(
2685
        param => {id1 => 4, id2 => 5, title => 'Perl', author => 'Ken'}
2686
    );
update pod
Yuki Kimoto authored on 2011-03-13
2687

            
updated pod
Yuki Kimoto authored on 2011-06-08
2688
=item C<id>
update pod
Yuki Kimoto authored on 2011-03-13
2689

            
updated pod
Yuki Kimoto authored on 2011-06-08
2690
update using primary_key.
update pod
Yuki Kimoto authored on 2011-03-13
2691

            
updated pod
Yuki Kimoto authored on 2011-06-08
2692
    $dbi->update(
2693
        primary_key => 'id',
2694
        id => 4,
2695
        param => {title => 'Perl', author => 'Ken'}
2696
    );
update pod
Yuki Kimoto authored on 2011-03-13
2697

            
updated pod
Yuki Kimoto authored on 2011-06-08
2698
    $dbi->update(
2699
        primary_key => ['id1', 'id2'],
2700
        id => [4, 5],
2701
        param => {title => 'Perl', author => 'Ken'}
2702
    );
update pod
Yuki Kimoto authored on 2011-03-13
2703

            
updated pod
Yuki Kimoto authored on 2011-06-08
2704
The above is same as the followin ones.
update pod
Yuki Kimoto authored on 2011-03-13
2705

            
updated pod
Yuki Kimoto authored on 2011-06-08
2706
    $dbi->update(
2707
        where => {id => 4}
2708
        param => {title => 'Perl', author => 'Ken'}
2709
    );
update pod
Yuki Kimoto authored on 2011-03-13
2710

            
updated pod
Yuki Kimoto authored on 2011-06-08
2711
    $dbi->update(
2712
        where => {id1 => 4, id2 => 5},
2713
        param => {title => 'Perl', author => 'Ken'}
2714
    );
update pod
Yuki Kimoto authored on 2011-03-13
2715

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2720
=back
update pod
Yuki Kimoto authored on 2011-03-13
2721

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2726
Update statement to update all rows.
2727
Options is same as C<update()>.
update pod
Yuki Kimoto authored on 2011-03-13
2728

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

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

            
2733
Create update parameter tag.
2734

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

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

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

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

            
2746
Create a new L<DBIx::Custom::Where> object.
2747

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

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

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

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

            
2757
Update statement, using primary key.
2758

            
2759
    $dbi->update_at(
2760
        table => 'book',
2761
        primary_key => 'id',
2762
        where => '5',
2763
        param => {title => 'Perl'}
2764
    );
2765

            
2766
This method is same as C<update()> exept that
2767
C<primary_key> is specified and C<where> is constant value or array refrence.
2768
all option of C<update()> is available.
2769

            
2770
=head2 C<delete_at()> DEPRECATED!
2771

            
2772
Delete statement, using primary key.
2773

            
2774
    $dbi->delete_at(
2775
        table => 'book',
2776
        primary_key => 'id',
2777
        where => '5'
2778
    );
2779

            
2780
This method is same as C<delete()> exept that
2781
C<primary_key> is specified and C<where> is constant value or array refrence.
2782
all option of C<delete()> is available.
2783

            
2784
=head2 C<select_at()> DEPRECATED!
2785

            
2786
Select statement, using primary key.
2787

            
2788
    $dbi->select_at(
2789
        table => 'book',
2790
        primary_key => 'id',
2791
        where => '5'
2792
    );
2793

            
2794
This method is same as C<select()> exept that
2795
C<primary_key> is specified and C<where> is constant value or array refrence.
2796
all option of C<select()> is available.
2797

            
2798
=head2 C<register_tag> DEPRECATED!
2799

            
2800
    $dbi->register_tag(
2801
        update => sub {
2802
            my @columns = @_;
2803
            
2804
            # Update parameters
2805
            my $s = 'set ';
2806
            $s .= "$_ = ?, " for @columns;
2807
            $s =~ s/, $//;
2808
            
2809
            return [$s, \@columns];
2810
        }
2811
    );
2812

            
2813
Register tag, used by C<execute()>.
2814

            
2815
See also L<Tags/Tags> about tag registered by default.
2816

            
2817
Tag parser receive arguments specified in tag.
2818
In the following tag, 'title' and 'author' is parser arguments
2819

            
2820
    {update_param title author} 
2821

            
2822
Tag parser must return array refrence,
2823
first element is the result statement, 
2824
second element is column names corresponding to place holders.
2825

            
2826
In this example, result statement is 
2827

            
2828
    set title = ?, author = ?
2829

            
2830
Column names is
2831

            
2832
    ['title', 'author']
2833

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2834
=head1 Parameter
2835

            
2836
Parameter start at ':'. This is replaced to place holoder
2837

            
2838
    $dbi->execute(
2839
        "select * from book where title = :title and author = :author"
2840
        param => {title => 'Perl', author => 'Ken'}
2841
    );
2842

            
2843
    "select * from book where title = ? and author = ?"
2844

            
2845
=head1 Tags DEPRECATED!
2846

            
2847
B<Tag> system is DEPRECATED! use parameter system :name instead.
2848
Parameter is simple and readable.
2849

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

            
2852
The following tags is available.
2853

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

            
2856
Placeholder tag.
2857

            
2858
    {? NAME}    ->   ?
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
Equal tag.
2863

            
2864
    {= NAME}    ->   NAME = ?
2865

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

            
2868
Not equal tag.
2869

            
2870
    {<> NAME}   ->   NAME <> ?
2871

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

            
2874
Lower than tag
2875

            
2876
    {< NAME}    ->   NAME < ?
2877

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

            
2880
Greater 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 or equal tag
2887

            
2888
    {>= NAME}   ->   NAME >= ?
2889

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

            
2892
Lower than or equal tag
2893

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

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

            
2898
Like tag
2899

            
2900
    {like NAME}   ->   NAME like ?
2901

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

            
2904
In tag.
2905

            
2906
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2907

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

            
2910
Insert parameter tag.
2911

            
2912
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2913

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

            
2916
Updata parameter tag.
2917

            
2918
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2919

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

            
2922
Insert statement, using primary key.
2923

            
2924
    $dbi->insert_at(
2925
        table => 'book',
2926
        primary_key => 'id',
2927
        where => '5',
2928
        param => {title => 'Perl'}
2929
    );
2930

            
2931
This method is same as C<insert()> exept that
2932
C<primary_key> is specified and C<where> is constant value or array refrence.
2933
all option of C<insert()> is available.
2934

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

            
2937
=head2 C<DBIX_CUSTOM_DEBUG>
2938

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

            
2942
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2943

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

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

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

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

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

            
2955
C<< <kimoto.yuki at gmail.com> >>
2956

            
2957
L<http://github.com/yuki-kimoto/DBIx-Custom>
2958

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2959
=head1 AUTHOR
2960

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

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

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

            
2967
This program is free software; you can redistribute it and/or modify it
2968
under the same terms as Perl itself.
2969

            
2970
=cut