DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2988 lines | 74.515kb
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
    
- select() column option can...
Yuki Kimoto authored on 2011-06-08
876
    # Reserved word quote
877
    my $q = $self->reserved_word_quote;
878
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
879
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
880
    if ($columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-07
881
        $columns = [$columns] unless ref $columns eq 'ARRAY';
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
882
        foreach my $column (@$columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-08
883
            if (ref $column eq 'HASH') {
884
                $column = $self->col(%$column) if ref $column eq 'HASH';
885
            }
886
            elsif (ref $column eq 'ARRAY') {
887
                croak "Format must be [COLUMN, as => ALIAS] " . _subname
888
                  unless @$column == 3 && $column->[1] eq 'as';
889
                $column = join(' ', $column->[0], 'as', $q . $column->[2] . $q);
890
            }
cleanup
Yuki Kimoto authored on 2011-04-02
891
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
892
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
893
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
894
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
895
    }
896
    else { push @sql, '*' }
897
    
898
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
899
    push @sql, 'from';
900
    if ($relation) {
901
        my $found = {};
902
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
903
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
904
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
905
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
906
    }
cleanup
Yuki Kimoto authored on 2011-03-30
907
    else {
908
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
909
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
910
    }
911
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
912
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
913
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
914

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
974
sub setup_model {
975
    my $self = shift;
976
    
cleanup
Yuki Kimoto authored on 2011-04-02
977
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
978
    $self->each_column(
979
        sub {
980
            my ($self, $table, $column, $column_info) = @_;
981
            if (my $model = $self->models->{$table}) {
982
                push @{$model->columns}, $column;
983
            }
984
        }
985
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
986
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
987
}
988

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

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

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

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

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

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1069
sub update_param {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1070
    my ($self, $param, $opt) = @_;
1071
    
cleanup
Yuki Kimoto authored on 2011-04-02
1072
    # Create update parameter tag
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1073
    my $tag = $self->assign_param($param);
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1074
    $tag = "set $tag" unless $opt->{no_set};
1075

            
cleanup
Yuki Kimoto authored on 2011-04-02
1076
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1077
}
1078

            
cleanup
Yuki Kimoto authored on 2011-01-25
1079
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1080
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1081
    
1082
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1083
    return DBIx::Custom::Where->new(
1084
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1085
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1086
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1087
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1088
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1089
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1090

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1189
sub _croak {
1190
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1191
    
1192
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1193
    $append ||= "";
1194
    
1195
    # Verbose
1196
    if ($Carp::Verbose) { croak $error }
1197
    
1198
    # Not verbose
1199
    else {
1200
        
1201
        # Remove line and module infromation
1202
        my $at_pos = rindex($error, ' at ');
1203
        $error = substr($error, 0, $at_pos);
1204
        $error =~ s/\s+$//;
1205
        croak "$error$append";
1206
    }
1207
}
1208

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1209
sub _need_tables {
1210
    my ($self, $tree, $need_tables, $tables) = @_;
1211
    
cleanup
Yuki Kimoto authored on 2011-04-02
1212
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1213
    foreach my $table (@$tables) {
1214
        if ($tree->{$table}) {
1215
            $need_tables->{$table} = 1;
1216
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1217
        }
1218
    }
1219
}
1220

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1262
sub _remove_duplicate_table {
1263
    my ($self, $tables, $main_table) = @_;
1264
    
1265
    # Remove duplicate table
1266
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1267
    delete $tables{$main_table} if $main_table;
1268
    
1269
    return [keys %tables, $main_table ? $main_table : ()];
1270
}
1271

            
cleanup
Yuki Kimoto authored on 2011-04-02
1272
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1273
    my ($self, $source) = @_;
1274
    
cleanup
Yuki Kimoto authored on 2011-04-02
1275
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1276
    my $tables = [];
1277
    my $safety_character = $self->safety_character;
1278
    my $q = $self->reserved_word_quote;
1279
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1280
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1281
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1282
    while ($source =~ /$table_re/g) {
1283
        push @$tables, $1;
1284
    }
1285
    
1286
    return $tables;
1287
}
1288

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1331
# DEPRECATED!
1332
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
1333
sub select_at {
1334
    my ($self, %args) = @_;
1335

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

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

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1361
# DEPRECATED!
1362
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1363
sub delete_at {
1364
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1365

            
1366
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1367
    
1368
    # Arguments
1369
    my $primary_keys = delete $args{primary_key};
1370
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1371
    my $where = delete $args{where};
1372
    
1373
    # Check arguments
1374
    foreach my $name (keys %args) {
1375
        croak qq{"$name" is wrong option } . _subname
1376
          unless $DELETE_AT_ARGS{$name};
1377
    }
1378
    
1379
    # Create where parameter
1380
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1381
    
1382
    return $self->delete(where => $where_param, %args);
1383
}
1384

            
cleanup
Yuki Kimoto authored on 2011-06-08
1385
# DEPRECATED!
1386
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1387
sub update_at {
1388
    my $self = shift;
1389

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

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

            
added warnings
Yuki Kimoto authored on 2011-06-07
1444
# DEPRECATED!
1445
sub register_tag {
1446
    warn "register_tag is DEPRECATED!";
1447
    shift->query_builder->register_tag(@_)
1448
}
1449

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1450
# DEPRECATED!
1451
__PACKAGE__->attr('data_source');
1452

            
cleanup
Yuki Kimoto authored on 2011-01-25
1453
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1454
__PACKAGE__->attr(
1455
    dbi_options => sub { {} },
1456
    filter_check  => 1
1457
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1458

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1483
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1484
sub default_fetch_filter {
1485
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1486

            
1487
    warn "default_fetch_filter is DEPRECATED! use apply_filter instead\n";
cleanup
Yuki Kimoto authored on 2011-01-12
1488
    
1489
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1490
        my $fname = $_[0];
1491

            
cleanup
Yuki Kimoto authored on 2011-01-12
1492
        if (@_ && !$fname) {
1493
            $self->{default_in_filter} = undef;
1494
        }
1495
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1496
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1497
              unless exists $self->filters->{$fname};
1498
        
1499
            $self->{default_in_filter} = $self->filters->{$fname};
1500
        }
1501
        
1502
        return $self;
1503
    }
1504
    
many changed
Yuki Kimoto authored on 2011-01-23
1505
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1506
}
1507

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1508
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1509
sub insert_param_tag {
1510
    warn "insert_param_tag is DEPRECATED! " .
1511
         "use insert_param instead!";
1512
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1513
}
1514

            
cleanup
Yuki Kimoto authored on 2011-01-25
1515
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1516
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1517
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1518
    return shift->query_builder->register_tag_processor(@_);
1519
}
1520

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

            
1543
# DEPRECATED!
1544
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1545
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1546
    
1547
    if (keys %{$relation || {}}) {
1548
        foreach my $rcolumn (keys %$relation) {
1549
            my $table1 = (split (/\./, $rcolumn))[0];
1550
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1551
            my $table1_exists;
1552
            my $table2_exists;
1553
            foreach my $table (@$tables) {
1554
                $table1_exists = 1 if $table eq $table1;
1555
                $table2_exists = 1 if $table eq $table2;
1556
            }
1557
            unshift @$tables, $table1 unless $table1_exists;
1558
            unshift @$tables, $table2 unless $table2_exists;
1559
        }
1560
    }
1561
}
1562

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1565
=head1 NAME
1566

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

            
1569
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1570

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1571
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1572
    
1573
    # Connect
1574
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1575
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1576
        user => 'ken',
1577
        password => '!LFKD%$&',
1578
        dbi_option => {mysql_enable_utf8 => 1}
1579
    );
cleanup
yuki-kimoto authored on 2010-08-05
1580

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1581
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1582
    $dbi->insert(
1583
        table  => 'book',
1584
        param  => {title => 'Perl', author => 'Ken'}
1585
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1586
    
1587
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1588
    $dbi->update(
1589
        table  => 'book', 
1590
        param  => {title => 'Perl', author => 'Ken'}, 
1591
        where  => {id => 5},
1592
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1593
    
1594
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1595
    $dbi->delete(
1596
        table  => 'book',
1597
        where  => {author => 'Ken'},
1598
    );
cleanup
yuki-kimoto authored on 2010-08-05
1599

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

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

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

            
1638
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1639

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1649
=item *
1650

            
1651
Filter when data is send or receive.
1652

            
1653
=item *
1654

            
1655
Data filtering system
1656

            
1657
=item *
1658

            
1659
Model support.
1660

            
1661
=item *
1662

            
1663
Generate where clause dinamically.
1664

            
1665
=item *
1666

            
1667
Generate join clause dinamically.
1668

            
1669
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1670

            
1671
=head1 GUIDE
1672

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

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

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

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

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

            
1683
    my $connector = $dbi->connector;
1684
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1685

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

            
1689
This is L<DBIx::Connector> example. Please pass
1690
C<default_dbi_option> to L<DBIx::Connector>.
1691

            
1692
    my $connector = DBIx::Connector->new(
1693
        "dbi:mysql:database=$DATABASE",
1694
        $USER,
1695
        $PASSWORD,
1696
        DBIx::Custom->new->default_dbi_option
1697
    );
1698
    
1699
    my $dbi = DBIx::Custom->new(connector => $connector);
1700

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

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

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

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

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

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

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

            
1718
=head2 C<default_dbi_option>
1719

            
1720
    my $default_dbi_option = $dbi->default_dbi_option;
1721
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1722

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1726
    {
1727
        RaiseError => 1,
1728
        PrintError => 0,
1729
        AutoCommit => 1,
1730
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1731

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

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

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

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

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

            
1744
    my $models = $dbi->models;
1745
    $dbi       = $dbi->models(\%models);
1746

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1749
=head2 C<password>
1750

            
1751
    my $password = $dbi->password;
1752
    $dbi         = $dbi->password('lkj&le`@s');
1753

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

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

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

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

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

            
1765
     my reserved_word_quote = $dbi->reserved_word_quote;
1766
     $dbi                   = $dbi->reserved_word_quote('"');
1767

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1787
    my $user = $dbi->user;
1788
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1789

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1800
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1801
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1802
        'issue_date' => {
1803
            out => 'tp_to_date',
1804
            in  => 'date_to_tp',
1805
            end => 'tp_to_displaydate'
1806
        },
1807
        'write_date' => {
1808
            out => 'tp_to_date',
1809
            in  => 'date_to_tp',
1810
            end => 'tp_to_displaydate'
1811
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1812
    );
1813

            
update pod
Yuki Kimoto authored on 2011-03-13
1814
Apply filter to columns.
1815
C<out> filter is executed before data is send to database.
1816
C<in> filter is executed after a row is fetch.
1817
C<end> filter is execute after C<in> filter is executed.
1818

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1821
       PETTERN         EXAMPLE
1822
    1. Column        : author
1823
    2. Table.Column  : book.author
1824
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1825

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

            
1829
You can set multiple filters at once.
1830

            
1831
    $dbi->apply_filter(
1832
        'book',
1833
        [qw/issue_date write_date/] => {
1834
            out => 'tp_to_date',
1835
            in  => 'date_to_tp',
1836
            end => 'tp_to_displaydate'
1837
        }
1838
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1839

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

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

            
1844
Create assign tag.
1845

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

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

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

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

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

            
1856
    book.author as "book.author",
1857
    book.title as "book.title"
1858

            
1859
=head2 C<column> EXPERIMETNAL
1860

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

            
1863
Create column clause. The follwoing column clause is created.
1864

            
1865
    book.author as book__author,
1866
    book.title as book__title
1867

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1870
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1871
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1872
        user => 'ken',
1873
        password => '!LFKD%$&',
1874
        dbi_option => {mysql_enable_utf8 => 1}
1875
    );
1876

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1885
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1886
        table => 'book',
1887
        primary_key => 'id',
1888
        join => [
1889
            'inner join company on book.comparny_id = company.id'
1890
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1891
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1892
            publish_date => {
1893
                out => 'tp_to_date',
1894
                in => 'date_to_tp',
1895
                end => 'tp_to_displaydate'
1896
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1897
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1898
    );
1899

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

            
1903
   $dbi->model('book')->select(...);
1904

            
cleanup
yuki-kimoto authored on 2010-10-17
1905
=head2 C<create_query>
1906
    
1907
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1908
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1909
    );
update document
yuki-kimoto authored on 2009-11-19
1910

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

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

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

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

            
1921
    my $dbh = $dbi->dbh;
1922

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

            
1926
=head2 C<each_column>
1927

            
1928
    $dbi->each_column(
1929
        sub {
1930
            my ($dbi, $table, $column, $column_info) = @_;
1931
            
1932
            my $type = $column_info->{TYPE_NAME};
1933
            
1934
            if ($type eq 'DATE') {
1935
                # ...
1936
            }
1937
        }
1938
    );
1939

            
1940
Iterate all column informations of all table from database.
1941
Argument is callback when one column is found.
1942
Callback receive four arguments, dbi object, table name,
1943
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1944

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

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

            
1952
Execute SQL, containing tags.
1953
Return value is L<DBIx::Custom::Result> in select statement, or
1954
the count of affected rows in insert, update, delete statement.
1955

            
1956
Tag is turned into the statement containing place holder
1957
before SQL is executed.
1958

            
1959
    select * from where title = ? and author like ?;
1960

            
1961
See also L<Tags/Tags>.
1962

            
1963
The following opitons are currently available.
1964

            
1965
=over 4
1966

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

            
1969
Table names for filtering.
1970

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

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

            
1976

            
1977

            
1978

            
1979

            
1980

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

            
1983
Filter, executed before data is send to database. This is array reference.
1984
Filter value is code reference or
1985
filter name registerd by C<register_filter()>.
1986

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

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

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

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

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

            
2021
Delete statement.
2022

            
2023
The following opitons are currently available.
2024

            
update pod
Yuki Kimoto authored on 2011-03-13
2025
=over 4
2026

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

            
2029
Table name.
2030

            
2031
    $dbi->delete(table => 'book');
2032

            
2033
=item C<where>
2034

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
2048
    # String(with where_param option)
2049
    $dbi->delete(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2050
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2051
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2052
    );
2053
    
update pod
Yuki Kimoto authored on 2011-03-13
2054
=item C<append>
2055

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

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

            
2060
=item C<filter>
2061

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

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

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

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

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

            
2096
    my $query = $dbi->delete(query => 1);
2097

            
2098
You can check SQL.
2099

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2106
    $dbi->delete(
update pod
Yuki Kimoto authored on 2011-03-13
2107
        primary_key => 'id',
updated pod
Yuki Kimoto authored on 2011-06-08
2108
        id => 4,
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2109
    );
2110

            
updated pod
Yuki Kimoto authored on 2011-06-08
2111
    $dbi->delete(
2112
        primary_key => ['id1', 'id2'],
2113
        id => [4, 5],
2114
    );
update pod
Yuki Kimoto authored on 2011-03-13
2115

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2126
=back
update pod
Yuki Kimoto authored on 2011-03-13
2127

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2135
=head2 C<insert>
2136

            
update pod
Yuki Kimoto authored on 2011-03-13
2137
    $dbi->insert(
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2138
        param  => {title => 'Perl', author => 'Ken'},
2139
        table  => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2140
    );
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2141
    
update pod
Yuki Kimoto authored on 2011-03-13
2142
Insert statement.
2143

            
2144
The following opitons are currently available.
2145

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

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

            
2150
Insert data. This is hash reference.
2151

            
2152
    $dbi->insert(param => {title => 'Perl'});
2153

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

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

            
2158
=item C<table>
2159

            
2160
Table name.
2161

            
2162
    $dbi->insert(table => 'book');
2163

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

            
2166
Append statement to last of SQL. This is string.
2167

            
2168
    $dbi->insert(append => 'order by title');
2169

            
2170
=item C<filter>
2171

            
2172
Filter, executed before data is send to database. This is array reference.
2173
Filter value is code reference or
2174
filter name registerd by C<register_filter()>.
2175

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

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

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

            
2203
Get L<DBIx::Custom::Query> object instead of executing SQL.
2204
This is true or false value.
2205

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2212
=back
2213

            
2214
=over 4
2215

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2231
    lib / MyModel.pm
2232
        / MyModel / book.pm
2233
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2234

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

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

            
2239
    package MyModel;
2240
    
2241
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2242
    
2243
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2244

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2247
B<MyModel/book.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::book;
2250
    
2251
    use base 'MyModel';
2252
    
2253
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2254

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2257
    package MyModel::company;
2258
    
2259
    use base 'MyModel';
2260
    
2261
    1;
2262
    
2263
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2264

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

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

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

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

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

            
2276
Merge paramters.
2277

            
2278
$param:
2279

            
2280
    {key1 => [1, 1], key2 => 2}
2281

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

            
2284
    $dbi->method(
2285
        update_or_insert => sub {
2286
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2287
            
2288
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2289
        },
2290
        find_or_create   => sub {
2291
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2292
            
2293
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2294
        }
2295
    );
2296

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

            
2299
    $dbi->update_or_insert;
2300
    $dbi->find_or_create;
2301

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

            
2304
    $dbi->model('book')->method(
2305
        insert => sub { ... },
2306
        update => sub { ... }
2307
    );
2308
    
2309
    my $model = $dbi->model('book');
2310

            
2311
Set and get a L<DBIx::Custom::Model> object,
2312

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

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

            
2317
Create column clause for myself. The follwoing column clause is created.
2318

            
2319
    book.author as author,
2320
    book.title as title
2321

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2324
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2325
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2326
        user => 'ken',
2327
        password => '!LFKD%$&',
2328
        dbi_option => {mysql_enable_utf8 => 1}
2329
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2330

            
2331
Create a new L<DBIx::Custom> object.
2332

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

            
2335
    my $not_exists = $dbi->not_exists;
2336

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2340
=head2 C<register_filter>
2341

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2359
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2360
        table  => 'book',
2361
        column => ['author', 'title'],
2362
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2363
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2364
    
update pod
Yuki Kimoto authored on 2011-03-12
2365
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2366

            
2367
The following opitons are currently available.
2368

            
2369
=over 4
2370

            
2371
=item C<table>
2372

            
2373
Table name.
2374

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

            
2377
=item C<column>
2378

            
2379
Column clause. This is array reference or constant value.
2380

            
updated pod
Yuki Kimoto authored on 2011-06-07
2381
    # Array reference
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2382
    $dbi->select(column => ['author', 'title']);
2383
    
2384
    # Constant value
2385
    $dbi->select(column => 'author');
updated pod
Yuki Kimoto authored on 2011-06-07
2386
    
2387
Default is '*' if C<column> is not specified.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2388

            
2389
    # Default
2390
    $dbi->select(column => '*');
2391

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

            
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
2394
    # Hash reference EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-07
2395
    $dbi->select(column => [
2396
        {book => [qw/author title/]},
2397
        {person => [qw/name age/]}
2398
    ]);
2399

            
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2400
This is expanded to the following one by C<col> method automatically.
2401

            
2402
    book.author as "book.author",
2403
    book.title as "book.title",
2404
    person.name as "person.name",
2405
    person.age as "person.age"
2406

            
2407
You can specify array reference in array refernce.
2408

            
2409
    $dbi->select(column => [
2410
        ['date(book.register_datetime)', as => 'book.register_date']
2411
    ]);
2412

            
2413
These is joined and quoted.
2414

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

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2419
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2420
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2421
    
2422
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2423
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2424
    
update pod
Yuki Kimoto authored on 2011-03-12
2425
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2426
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2427
        clause => ['and', 'author = :author', 'title like :title'],
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2428
        param  => {author => 'Ken', title => '%Perl%'}
2429
    );
update pod
Yuki Kimoto authored on 2011-03-12
2430
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2431

            
updated pod
Yuki Kimoto authored on 2011-04-25
2432
    # String(with where_param option)
2433
    $dbi->select(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2434
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2435
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2436
    );
2437
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2438
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2439

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

            
2442
    $dbi->select(join =>
2443
        [
2444
            'left outer join company on book.company_id = company_id',
2445
            'left outer join location on company.location_id = location.id'
2446
        ]
2447
    );
2448

            
2449
If column cluase or where clause contain table name like "company.name",
2450
needed join clause is used automatically.
2451

            
2452
    $dbi->select(
2453
        table => 'book',
2454
        column => ['company.location_id as company__location_id'],
2455
        where => {'company.name' => 'Orange'},
2456
        join => [
2457
            'left outer join company on book.company_id = company.id',
2458
            'left outer join location on company.location_id = location.id'
2459
        ]
2460
    );
2461

            
2462
In above select, the following SQL is created.
2463

            
2464
    select company.location_id as company__location_id
2465
    from book
2466
      left outer join company on book.company_id = company.id
2467
    where company.name = Orange
2468

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

            
2471
Parameter shown before where clause.
2472
    
2473
    $dbi->select(
2474
        table => 'table1',
2475
        column => 'table1.key1 as table1_key1, key2, key3',
2476
        where   => {'table1.key2' => 3},
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2477
        join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2478
                  ' as table2 on table1.key1 = table2.key1'],
2479
        param => {'table2.key3' => 5}
2480
    );
2481

            
2482
For example, if you want to contain tag in join clause, 
2483
you can pass parameter by C<param> option.
2484

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

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

            
2489
    $dbi->select(append => 'order by title');
updated pod
Yuki Kimoto authored on 2011-06-08
2490
    
2491
=item C<id>
2492

            
2493
Select using primary_key.
2494

            
2495
    $dbi->select(
2496
        primary_key => 'id',
2497
        id => 4,
2498
    );
2499

            
2500
    $dbi->select(
2501
        primary_key => ['id1', 'id2'],
2502
        id => [4, 5]
2503
    );
2504

            
2505
The above is same as the followin ones.
2506

            
2507
    $dbi->insert(where => {id => 4});
2508

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

            
2511
=item C<primary_key>
2512

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

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

            
2517
Wrap statement. This is array reference.
2518

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

            
2521
This option is for Oracle and SQL Server paging process.
2522

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

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

            
2529
    # Basic
2530
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2531
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2532
            title  => sub { uc $_[0] }
2533
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2534
        }
update pod
Yuki Kimoto authored on 2011-03-12
2535
    );
2536
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2537
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2538
    $dbi->select(
2539
        filter => [
2540
            [qw/title author/]  => sub { uc $_[0] }
2541
        ]
2542
    );
2543
    
2544
    # Filter name
2545
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2546
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2547
            title  => 'upper_case',
2548
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2549
        }
update pod
Yuki Kimoto authored on 2011-03-12
2550
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2551

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

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

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

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

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

            
2563
    my $sql = $query->sql;
2564

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

            
2567
Specify database data type.
2568

            
2569
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2570
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2571

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

            
2574
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2575

            
update pod
Yuki Kimoto authored on 2011-03-12
2576
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2577

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2590
=over 4
2591

            
2592
=item C<param>
2593

            
2594
Update data. This is hash reference.
2595

            
2596
    $dbi->update(param => {title => 'Perl'});
2597

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

            
2600
    $dbi->update(
2601
        {title => 'Perl'},
2602
        table => 'book',
2603
        where => {author => 'Ken'}
2604
    );
2605

            
2606
=item C<table>
2607

            
2608
Table name.
2609

            
2610
    $dbi->update(table => 'book');
2611

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2614
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2615
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2616
    
2617
    # Hash reference
2618
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2619
    
2620
    # DBIx::Custom::Where object
2621
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2622
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2623
        param  => {author => 'Ken', title => '%Perl%'}
2624
    );
2625
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2626
    
updated pod
Yuki Kimoto authored on 2011-04-25
2627
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2628
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2629
        param => {title => 'Perl'},
updated pod
Yuki Kimoto authored on 2011-06-08
2630
        where => 'id = :id',
updated pod
Yuki Kimoto authored on 2011-04-25
2631
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2632
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2633
    
update pod
Yuki Kimoto authored on 2011-03-13
2634
=item C<append>
2635

            
2636
Append statement to last of SQL. This is string.
2637

            
2638
    $dbi->update(append => 'order by title');
2639

            
2640
=item C<filter>
2641

            
2642
Filter, executed before data is send to database. This is array reference.
2643
Filter value is code reference or
2644
filter name registerd by C<register_filter()>.
2645

            
2646
    # Basic
2647
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2648
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2649
            title  => sub { uc $_[0] }
2650
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2651
        }
update pod
Yuki Kimoto authored on 2011-03-13
2652
    );
2653
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2654
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2655
    $dbi->update(
2656
        filter => [
2657
            [qw/title author/]  => sub { uc $_[0] }
2658
        ]
2659
    );
2660
    
2661
    # Filter name
2662
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2663
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2664
            title  => 'upper_case',
2665
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2666
        }
update pod
Yuki Kimoto authored on 2011-03-13
2667
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2668

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

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

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

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

            
2678
You can check SQL.
2679

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2684
    $dbi->insert(
2685
        primary_key => 'id',
2686
        id => 4,
2687
        param => {title => 'Perl', author => 'Ken'}
2688
    );
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2689

            
updated pod
Yuki Kimoto authored on 2011-06-08
2690
    $dbi->insert(
2691
        primary_key => ['id1', 'id2'],
2692
        id => [4, 5],
2693
        param => {title => 'Perl', author => 'Ken'}
2694
    );
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2695

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2710
    $dbi->update(
2711
        primary_key => 'id',
2712
        id => 4,
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
    $dbi->update(
2717
        primary_key => ['id1', 'id2'],
2718
        id => [4, 5],
2719
        param => {title => 'Perl', author => 'Ken'}
2720
    );
update pod
Yuki Kimoto authored on 2011-03-13
2721

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2724
    $dbi->update(
2725
        where => {id => 4}
2726
        param => {title => 'Perl', author => 'Ken'}
2727
    );
update pod
Yuki Kimoto authored on 2011-03-13
2728

            
updated pod
Yuki Kimoto authored on 2011-06-08
2729
    $dbi->update(
2730
        where => {id1 => 4, id2 => 5},
2731
        param => {title => 'Perl', author => 'Ken'}
2732
    );
update pod
Yuki Kimoto authored on 2011-03-13
2733

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2738
=back
update pod
Yuki Kimoto authored on 2011-03-13
2739

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

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

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

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

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

            
2751
Create update parameter tag.
2752

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

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

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

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

            
2764
Create a new L<DBIx::Custom::Where> object.
2765

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

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

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

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

            
2775
Update statement, using primary key.
2776

            
2777
    $dbi->update_at(
2778
        table => 'book',
2779
        primary_key => 'id',
2780
        where => '5',
2781
        param => {title => 'Perl'}
2782
    );
2783

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

            
2788
=head2 C<delete_at()> DEPRECATED!
2789

            
2790
Delete statement, using primary key.
2791

            
2792
    $dbi->delete_at(
2793
        table => 'book',
2794
        primary_key => 'id',
2795
        where => '5'
2796
    );
2797

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

            
2802
=head2 C<select_at()> DEPRECATED!
2803

            
2804
Select statement, using primary key.
2805

            
2806
    $dbi->select_at(
2807
        table => 'book',
2808
        primary_key => 'id',
2809
        where => '5'
2810
    );
2811

            
2812
This method is same as C<select()> exept that
2813
C<primary_key> is specified and C<where> is constant value or array refrence.
2814
all option of C<select()> is available.
2815

            
2816
=head2 C<register_tag> DEPRECATED!
2817

            
2818
    $dbi->register_tag(
2819
        update => sub {
2820
            my @columns = @_;
2821
            
2822
            # Update parameters
2823
            my $s = 'set ';
2824
            $s .= "$_ = ?, " for @columns;
2825
            $s =~ s/, $//;
2826
            
2827
            return [$s, \@columns];
2828
        }
2829
    );
2830

            
2831
Register tag, used by C<execute()>.
2832

            
2833
See also L<Tags/Tags> about tag registered by default.
2834

            
2835
Tag parser receive arguments specified in tag.
2836
In the following tag, 'title' and 'author' is parser arguments
2837

            
2838
    {update_param title author} 
2839

            
2840
Tag parser must return array refrence,
2841
first element is the result statement, 
2842
second element is column names corresponding to place holders.
2843

            
2844
In this example, result statement is 
2845

            
2846
    set title = ?, author = ?
2847

            
2848
Column names is
2849

            
2850
    ['title', 'author']
2851

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2852
=head1 Parameter
2853

            
2854
Parameter start at ':'. This is replaced to place holoder
2855

            
2856
    $dbi->execute(
2857
        "select * from book where title = :title and author = :author"
2858
        param => {title => 'Perl', author => 'Ken'}
2859
    );
2860

            
2861
    "select * from book where title = ? and author = ?"
2862

            
2863
=head1 Tags DEPRECATED!
2864

            
2865
B<Tag> system is DEPRECATED! use parameter system :name instead.
2866
Parameter is simple and readable.
2867

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

            
2870
The following tags is available.
2871

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

            
2874
Placeholder tag.
2875

            
2876
    {? NAME}    ->   ?
2877

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

            
2880
Equal tag.
2881

            
2882
    {= NAME}    ->   NAME = ?
2883

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

            
2886
Not 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 tag
2893

            
2894
    {< NAME}    ->   NAME < ?
2895

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

            
2898
Greater than tag
2899

            
2900
    {> NAME}    ->   NAME > ?
2901

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

            
2904
Greater than or equal tag
2905

            
2906
    {>= NAME}   ->   NAME >= ?
2907

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

            
2910
Lower than or equal tag
2911

            
2912
    {<= NAME}   ->   NAME <= ?
2913

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

            
2916
Like tag
2917

            
2918
    {like NAME}   ->   NAME like ?
2919

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

            
2922
In tag.
2923

            
2924
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2925

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

            
2928
Insert parameter tag.
2929

            
2930
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2931

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

            
2934
Updata parameter tag.
2935

            
2936
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2937

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

            
2940
Insert statement, using primary key.
2941

            
2942
    $dbi->insert_at(
2943
        table => 'book',
2944
        primary_key => 'id',
2945
        where => '5',
2946
        param => {title => 'Perl'}
2947
    );
2948

            
2949
This method is same as C<insert()> exept that
2950
C<primary_key> is specified and C<where> is constant value or array refrence.
2951
all option of C<insert()> is available.
2952

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

            
2955
=head2 C<DBIX_CUSTOM_DEBUG>
2956

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

            
2960
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2961

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

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

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

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

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

            
2973
C<< <kimoto.yuki at gmail.com> >>
2974

            
2975
L<http://github.com/yuki-kimoto/DBIx-Custom>
2976

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2977
=head1 AUTHOR
2978

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

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

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

            
2985
This program is free software; you can redistribute it and/or modify it
2986
under the same terms as Perl itself.
2987

            
2988
=cut