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

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
3
our $VERSION = '0.1687';
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(
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
569
            sth => $sth,
570
            filters => $self->filters,
cleanup
Yuki Kimoto authored on 2011-01-12
571
            default_filter => $self->{default_in_filter},
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
572
            filter => $filter->{in} || {},
573
            end_filter => $filter->{end} || {},
574
            type_rule => $self->type_rule,
cleanup
yuki-kimoto authored on 2010-10-17
575
        );
576

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
990
sub type_rule {
991
    my $self = shift;
992
    
993
    if (@_) {
994
        my $type_rule = _array_to_hash([@_]);
995
        $self->{type_rule} = $type_rule;
996
        
997
        return $self;
998
    }
999
    
1000
    return $self->{type_rule} || {};
1001
}
1002

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1009
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1010
    my $param;
1011
    $param = shift if @_ % 2;
1012
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
1013
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
1014
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
1015
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1016
    my $p = delete $args{param} || {};
1017
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
1018
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1019
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
1020
    my $append           = delete $args{append} || '';
1021
    my $allow_update_all = delete $args{allow_update_all};
cleanup
Yuki Kimoto authored on 2011-06-08
1022
    my $id = delete $args{id};
1023
    my $primary_key = delete $args{primary_key};
1024
    croak "update method primary_key option " .
1025
          "must be specified when id is specified " . _subname
1026
      if defined $id && !defined $primary_key;
1027
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
version 0.0901
yuki-kimoto authored on 2009-12-17
1028
    
cleanup
Yuki Kimoto authored on 2011-04-02
1029
    # Check argument names
1030
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1031
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1032
          unless $UPDATE_ARGS{$name};
1033
    }
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1034

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

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

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1083
sub update_param {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1084
    my ($self, $param, $opt) = @_;
1085
    
cleanup
Yuki Kimoto authored on 2011-04-02
1086
    # Create update parameter tag
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1087
    my $tag = $self->assign_param($param);
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1088
    $tag = "set $tag" unless $opt->{no_set};
1089

            
cleanup
Yuki Kimoto authored on 2011-04-02
1090
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1091
}
1092

            
cleanup
Yuki Kimoto authored on 2011-01-25
1093
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1094
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1095
    
1096
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1097
    return DBIx::Custom::Where->new(
1098
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1099
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1100
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1101
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1102
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1103
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1104

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

            
cleanup
Yuki Kimoto authored on 2011-06-08
1150
sub _create_param_from_id {
1151
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1152
    
cleanup
Yuki Kimoto authored on 2011-06-08
1153
    # Create parameter
1154
    my $param = {};
1155
    if ($id) {
1156
        $id = [$id] unless ref $id;
1157
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1158
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1159
          unless !ref $id || ref $id eq 'ARRAY';
1160
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1161
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1162
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1163
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1164
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1165
        }
1166
    }
1167
    
cleanup
Yuki Kimoto authored on 2011-06-08
1168
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1169
}
1170

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1171
sub _connect {
1172
    my $self = shift;
1173
    
1174
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1175
    my $dsn = $self->data_source;
1176
    warn "data_source is DEPRECATED! use dsn instead\n";
1177
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1178
    croak qq{"dsn" must be specified } . _subname
1179
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1180
    my $user        = $self->user;
1181
    my $password    = $self->password;
1182
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1183
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1184
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1185
    
1186
    # Connect
1187
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1188
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1189
        $user,
1190
        $password,
1191
        {
1192
            %{$self->default_dbi_option},
1193
            %$dbi_option
1194
        }
1195
    )};
1196
    
1197
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1198
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1199
    
1200
    return $dbh;
1201
}
1202

            
cleanup
yuki-kimoto authored on 2010-10-17
1203
sub _croak {
1204
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1205
    
1206
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1207
    $append ||= "";
1208
    
1209
    # Verbose
1210
    if ($Carp::Verbose) { croak $error }
1211
    
1212
    # Not verbose
1213
    else {
1214
        
1215
        # Remove line and module infromation
1216
        my $at_pos = rindex($error, ' at ');
1217
        $error = substr($error, 0, $at_pos);
1218
        $error =~ s/\s+$//;
1219
        croak "$error$append";
1220
    }
1221
}
1222

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1223
sub _need_tables {
1224
    my ($self, $tree, $need_tables, $tables) = @_;
1225
    
cleanup
Yuki Kimoto authored on 2011-04-02
1226
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1227
    foreach my $table (@$tables) {
1228
        if ($tree->{$table}) {
1229
            $need_tables->{$table} = 1;
1230
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1231
        }
1232
    }
1233
}
1234

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1276
sub _remove_duplicate_table {
1277
    my ($self, $tables, $main_table) = @_;
1278
    
1279
    # Remove duplicate table
1280
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1281
    delete $tables{$main_table} if $main_table;
1282
    
1283
    return [keys %tables, $main_table ? $main_table : ()];
1284
}
1285

            
cleanup
Yuki Kimoto authored on 2011-04-02
1286
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1287
    my ($self, $source) = @_;
1288
    
cleanup
Yuki Kimoto authored on 2011-04-02
1289
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1290
    my $tables = [];
1291
    my $safety_character = $self->safety_character;
1292
    my $q = $self->reserved_word_quote;
1293
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1294
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1295
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1296
    while ($source =~ /$table_re/g) {
1297
        push @$tables, $1;
1298
    }
1299
    
1300
    return $tables;
1301
}
1302

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1345
# DEPRECATED!
1346
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
1347
sub select_at {
1348
    my ($self, %args) = @_;
1349

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1352
    # Arguments
1353
    my $primary_keys = delete $args{primary_key};
1354
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1355
    my $where = delete $args{where};
1356
    my $param = delete $args{param};
1357
    
1358
    # Check arguments
1359
    foreach my $name (keys %args) {
1360
        croak qq{"$name" is wrong option } . _subname
1361
          unless $SELECT_AT_ARGS{$name};
1362
    }
1363
    
1364
    # Table
1365
    croak qq{"table" option must be specified } . _subname
1366
      unless $args{table};
1367
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1368
    
1369
    # Create where parameter
1370
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1371
    
1372
    return $self->select(where => $where_param, %args);
1373
}
1374

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1375
# DEPRECATED!
1376
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1377
sub delete_at {
1378
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1379

            
1380
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1381
    
1382
    # Arguments
1383
    my $primary_keys = delete $args{primary_key};
1384
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1385
    my $where = delete $args{where};
1386
    
1387
    # Check arguments
1388
    foreach my $name (keys %args) {
1389
        croak qq{"$name" is wrong option } . _subname
1390
          unless $DELETE_AT_ARGS{$name};
1391
    }
1392
    
1393
    # Create where parameter
1394
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1395
    
1396
    return $self->delete(where => $where_param, %args);
1397
}
1398

            
cleanup
Yuki Kimoto authored on 2011-06-08
1399
# DEPRECATED!
1400
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1401
sub update_at {
1402
    my $self = shift;
1403

            
1404
    warn "update_at is DEPRECATED! use update and id option instead";
1405
    
1406
    # Arguments
1407
    my $param;
1408
    $param = shift if @_ % 2;
1409
    my %args = @_;
1410
    my $primary_keys = delete $args{primary_key};
1411
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1412
    my $where = delete $args{where};
1413
    my $p = delete $args{param} || {};
1414
    $param  ||= $p;
1415
    
1416
    # Check arguments
1417
    foreach my $name (keys %args) {
1418
        croak qq{"$name" is wrong option } . _subname
1419
          unless $UPDATE_AT_ARGS{$name};
1420
    }
1421
    
1422
    # Create where parameter
1423
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1424
    
1425
    return $self->update(where => $where_param, param => $param, %args);
1426
}
1427

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1428
# DEPRECATED!
1429
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
1430
sub insert_at {
1431
    my $self = shift;
1432
    
1433
    warn "insert_at is DEPRECATED! use insert and id option instead";
1434
    
1435
    # Arguments
1436
    my $param;
1437
    $param = shift if @_ % 2;
1438
    my %args = @_;
1439
    my $primary_key = delete $args{primary_key};
1440
    $primary_key = [$primary_key] unless ref $primary_key;
1441
    my $where = delete $args{where};
1442
    my $p = delete $args{param} || {};
1443
    $param  ||= $p;
1444
    
1445
    # Check arguments
1446
    foreach my $name (keys %args) {
1447
        croak qq{"$name" is wrong option } . _subname
1448
          unless $INSERT_AT_ARGS{$name};
1449
    }
1450
    
1451
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1452
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1453
    $param = $self->merge_param($where_param, $param);
1454
    
1455
    return $self->insert(param => $param, %args);
1456
}
1457

            
added warnings
Yuki Kimoto authored on 2011-06-07
1458
# DEPRECATED!
1459
sub register_tag {
1460
    warn "register_tag is DEPRECATED!";
1461
    shift->query_builder->register_tag(@_)
1462
}
1463

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1464
# DEPRECATED!
1465
__PACKAGE__->attr('data_source');
1466

            
cleanup
Yuki Kimoto authored on 2011-01-25
1467
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1468
__PACKAGE__->attr(
1469
    dbi_options => sub { {} },
1470
    filter_check  => 1
1471
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1472

            
cleanup
Yuki Kimoto authored on 2011-01-25
1473
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1474
sub default_bind_filter {
1475
    my $self = shift;
1476
    
added warnings
Yuki Kimoto authored on 2011-06-07
1477
    warn "default_bind_filter is DEPRECATED! use apply_filter instead\n";
1478
    
cleanup
Yuki Kimoto authored on 2011-01-12
1479
    if (@_) {
1480
        my $fname = $_[0];
1481
        
1482
        if (@_ && !$fname) {
1483
            $self->{default_out_filter} = undef;
1484
        }
1485
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1486
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1487
              unless exists $self->filters->{$fname};
1488
        
1489
            $self->{default_out_filter} = $self->filters->{$fname};
1490
        }
1491
        return $self;
1492
    }
1493
    
1494
    return $self->{default_out_filter};
1495
}
1496

            
cleanup
Yuki Kimoto authored on 2011-01-25
1497
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1498
sub default_fetch_filter {
1499
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1500

            
1501
    warn "default_fetch_filter is DEPRECATED! use apply_filter instead\n";
cleanup
Yuki Kimoto authored on 2011-01-12
1502
    
1503
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1504
        my $fname = $_[0];
1505

            
cleanup
Yuki Kimoto authored on 2011-01-12
1506
        if (@_ && !$fname) {
1507
            $self->{default_in_filter} = undef;
1508
        }
1509
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1510
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1511
              unless exists $self->filters->{$fname};
1512
        
1513
            $self->{default_in_filter} = $self->filters->{$fname};
1514
        }
1515
        
1516
        return $self;
1517
    }
1518
    
many changed
Yuki Kimoto authored on 2011-01-23
1519
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1520
}
1521

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1522
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1523
sub insert_param_tag {
1524
    warn "insert_param_tag is DEPRECATED! " .
1525
         "use insert_param instead!";
1526
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1527
}
1528

            
cleanup
Yuki Kimoto authored on 2011-01-25
1529
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1530
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1531
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1532
    return shift->query_builder->register_tag_processor(@_);
1533
}
1534

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1535
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1536
sub update_param_tag {
1537
    warn "update_param is DEPRECATED! " .
1538
         "use update_param instead";
1539
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1540
}
cleanup
Yuki Kimoto authored on 2011-03-08
1541
# DEPRECATED!
1542
sub _push_relation {
1543
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1544
    
1545
    if (keys %{$relation || {}}) {
1546
        push @$sql, $need_where ? 'where' : 'and';
1547
        foreach my $rcolumn (keys %$relation) {
1548
            my $table1 = (split (/\./, $rcolumn))[0];
1549
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1550
            push @$tables, ($table1, $table2);
1551
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1552
        }
1553
    }
1554
    pop @$sql if $sql->[-1] eq 'and';    
1555
}
1556

            
1557
# DEPRECATED!
1558
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1559
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1560
    
1561
    if (keys %{$relation || {}}) {
1562
        foreach my $rcolumn (keys %$relation) {
1563
            my $table1 = (split (/\./, $rcolumn))[0];
1564
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1565
            my $table1_exists;
1566
            my $table2_exists;
1567
            foreach my $table (@$tables) {
1568
                $table1_exists = 1 if $table eq $table1;
1569
                $table2_exists = 1 if $table eq $table2;
1570
            }
1571
            unshift @$tables, $table1 unless $table1_exists;
1572
            unshift @$tables, $table2 unless $table2_exists;
1573
        }
1574
    }
1575
}
1576

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1579
=head1 NAME
1580

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

            
1583
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1584

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1585
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1586
    
1587
    # Connect
1588
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1589
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1590
        user => 'ken',
1591
        password => '!LFKD%$&',
1592
        dbi_option => {mysql_enable_utf8 => 1}
1593
    );
cleanup
yuki-kimoto authored on 2010-08-05
1594

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1595
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1596
    $dbi->insert(
1597
        table  => 'book',
1598
        param  => {title => 'Perl', author => 'Ken'}
1599
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1600
    
1601
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1602
    $dbi->update(
1603
        table  => 'book', 
1604
        param  => {title => 'Perl', author => 'Ken'}, 
1605
        where  => {id => 5},
1606
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1607
    
1608
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1609
    $dbi->delete(
1610
        table  => 'book',
1611
        where  => {author => 'Ken'},
1612
    );
cleanup
yuki-kimoto authored on 2010-08-05
1613

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

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

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

            
1652
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1653

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1663
=item *
1664

            
1665
Filter when data is send or receive.
1666

            
1667
=item *
1668

            
1669
Data filtering system
1670

            
1671
=item *
1672

            
1673
Model support.
1674

            
1675
=item *
1676

            
1677
Generate where clause dinamically.
1678

            
1679
=item *
1680

            
1681
Generate join clause dinamically.
1682

            
1683
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1684

            
1685
=head1 GUIDE
1686

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

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

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

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

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

            
1697
    my $connector = $dbi->connector;
1698
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1699

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

            
1703
This is L<DBIx::Connector> example. Please pass
1704
C<default_dbi_option> to L<DBIx::Connector>.
1705

            
1706
    my $connector = DBIx::Connector->new(
1707
        "dbi:mysql:database=$DATABASE",
1708
        $USER,
1709
        $PASSWORD,
1710
        DBIx::Custom->new->default_dbi_option
1711
    );
1712
    
1713
    my $dbi = DBIx::Custom->new(connector => $connector);
1714

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

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

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

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

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

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

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

            
1732
=head2 C<default_dbi_option>
1733

            
1734
    my $default_dbi_option = $dbi->default_dbi_option;
1735
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1736

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1740
    {
1741
        RaiseError => 1,
1742
        PrintError => 0,
1743
        AutoCommit => 1,
1744
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1745

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

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

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

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

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

            
1758
    my $models = $dbi->models;
1759
    $dbi       = $dbi->models(\%models);
1760

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1763
=head2 C<password>
1764

            
1765
    my $password = $dbi->password;
1766
    $dbi         = $dbi->password('lkj&le`@s');
1767

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

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

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

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

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

            
1779
     my reserved_word_quote = $dbi->reserved_word_quote;
1780
     $dbi                   = $dbi->reserved_word_quote('"');
1781

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1801
    my $user = $dbi->user;
1802
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1803

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1814
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1815
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1816
        'issue_date' => {
1817
            out => 'tp_to_date',
1818
            in  => 'date_to_tp',
1819
            end => 'tp_to_displaydate'
1820
        },
1821
        'write_date' => {
1822
            out => 'tp_to_date',
1823
            in  => 'date_to_tp',
1824
            end => 'tp_to_displaydate'
1825
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1826
    );
1827

            
update pod
Yuki Kimoto authored on 2011-03-13
1828
Apply filter to columns.
1829
C<out> filter is executed before data is send to database.
1830
C<in> filter is executed after a row is fetch.
1831
C<end> filter is execute after C<in> filter is executed.
1832

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1835
       PETTERN         EXAMPLE
1836
    1. Column        : author
1837
    2. Table.Column  : book.author
1838
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1839

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

            
1843
You can set multiple filters at once.
1844

            
1845
    $dbi->apply_filter(
1846
        'book',
1847
        [qw/issue_date write_date/] => {
1848
            out => 'tp_to_date',
1849
            in  => 'date_to_tp',
1850
            end => 'tp_to_displaydate'
1851
        }
1852
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1853

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

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

            
1858
Create assign tag.
1859

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

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

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

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

            
1868
Create column clause. The follwoing column clause is created.
1869

            
1870
    book.author as "book.author",
1871
    book.title as "book.title"
1872

            
1873
=head2 C<column> EXPERIMETNAL
1874

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

            
1877
Create column clause. The follwoing column clause is created.
1878

            
1879
    book.author as book__author,
1880
    book.title as book__title
1881

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1884
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1885
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1886
        user => 'ken',
1887
        password => '!LFKD%$&',
1888
        dbi_option => {mysql_enable_utf8 => 1}
1889
    );
1890

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1899
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1900
        table => 'book',
1901
        primary_key => 'id',
1902
        join => [
1903
            'inner join company on book.comparny_id = company.id'
1904
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1905
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1906
            publish_date => {
1907
                out => 'tp_to_date',
1908
                in => 'date_to_tp',
1909
                end => 'tp_to_displaydate'
1910
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1911
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1912
    );
1913

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

            
1917
   $dbi->model('book')->select(...);
1918

            
cleanup
yuki-kimoto authored on 2010-10-17
1919
=head2 C<create_query>
1920
    
1921
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1922
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1923
    );
update document
yuki-kimoto authored on 2009-11-19
1924

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

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

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

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

            
1935
    my $dbh = $dbi->dbh;
1936

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

            
1940
=head2 C<each_column>
1941

            
1942
    $dbi->each_column(
1943
        sub {
1944
            my ($dbi, $table, $column, $column_info) = @_;
1945
            
1946
            my $type = $column_info->{TYPE_NAME};
1947
            
1948
            if ($type eq 'DATE') {
1949
                # ...
1950
            }
1951
        }
1952
    );
1953

            
1954
Iterate all column informations of all table from database.
1955
Argument is callback when one column is found.
1956
Callback receive four arguments, dbi object, table name,
1957
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1958

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

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

            
1966
Execute SQL, containing tags.
1967
Return value is L<DBIx::Custom::Result> in select statement, or
1968
the count of affected rows in insert, update, delete statement.
1969

            
1970
Tag is turned into the statement containing place holder
1971
before SQL is executed.
1972

            
1973
    select * from where title = ? and author like ?;
1974

            
1975
See also L<Tags/Tags>.
1976

            
1977
The following opitons are currently available.
1978

            
1979
=over 4
1980

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

            
1983
Table names for filtering.
1984

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

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

            
1990

            
1991

            
1992

            
1993

            
1994

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

            
1997
Filter, executed before data is send to database. This is array reference.
1998
Filter value is code reference or
1999
filter name registerd by C<register_filter()>.
2000

            
2001
    # Basic
2002
    $dbi->execute(
2003
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2004
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2005
            title  => sub { uc $_[0] }
2006
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2007
        }
update pod
Yuki Kimoto authored on 2011-03-13
2008
    );
2009
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2010
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2011
    $dbi->execute(
2012
        $sql,
2013
        filter => [
2014
            [qw/title author/]  => sub { uc $_[0] }
2015
        ]
2016
    );
2017
    
2018
    # Filter name
2019
    $dbi->execute(
2020
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2021
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2022
            title  => 'upper_case',
2023
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2024
        }
update pod
Yuki Kimoto authored on 2011-03-13
2025
    );
2026

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

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

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

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

            
2035
Delete statement.
2036

            
2037
The following opitons are currently available.
2038

            
update pod
Yuki Kimoto authored on 2011-03-13
2039
=over 4
2040

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

            
2043
Table name.
2044

            
2045
    $dbi->delete(table => 'book');
2046

            
2047
=item C<where>
2048

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2049
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2050
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
2051
    
2052
    # Hash reference
2053
    $dbi->delete(where => {title => 'Perl'});
2054
    
2055
    # DBIx::Custom::Where object
2056
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2057
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2058
        param  => {author => 'Ken', title => '%Perl%'}
2059
    );
2060
    $dbi->delete(where => $where);
2061

            
updated pod
Yuki Kimoto authored on 2011-04-25
2062
    # String(with where_param option)
2063
    $dbi->delete(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2064
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2065
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2066
    );
2067
    
update pod
Yuki Kimoto authored on 2011-03-13
2068
=item C<append>
2069

            
2070
Append statement to last of SQL. This is string.
2071

            
2072
    $dbi->delete(append => 'order by title');
2073

            
2074
=item C<filter>
2075

            
2076
Filter, executed before data is send to database. This is array reference.
2077
Filter value is code reference or
2078
filter name registerd by C<register_filter()>.
2079

            
2080
    # Basic
2081
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2082
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2083
            title  => sub { uc $_[0] }
2084
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2085
        }
update pod
Yuki Kimoto authored on 2011-03-13
2086
    );
2087
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2088
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2089
    $dbi->delete(
2090
        filter => [
2091
            [qw/title author/]  => sub { uc $_[0] }
2092
        ]
2093
    );
2094
    
2095
    # Filter name
2096
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2097
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2098
            title  => 'upper_case',
2099
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2100
        }
update pod
Yuki Kimoto authored on 2011-03-13
2101
    );
2102

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

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

            
2107
Get L<DBIx::Custom::Query> object instead of executing SQL.
2108
This is true or false value.
2109

            
2110
    my $query = $dbi->delete(query => 1);
2111

            
2112
You can check SQL.
2113

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2120
    $dbi->delete(
update pod
Yuki Kimoto authored on 2011-03-13
2121
        primary_key => 'id',
updated pod
Yuki Kimoto authored on 2011-06-08
2122
        id => 4,
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2123
    );
2124

            
updated pod
Yuki Kimoto authored on 2011-06-08
2125
    $dbi->delete(
2126
        primary_key => ['id1', 'id2'],
2127
        id => [4, 5],
2128
    );
update pod
Yuki Kimoto authored on 2011-03-13
2129

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2140
=back
update pod
Yuki Kimoto authored on 2011-03-13
2141

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2149
=head2 C<insert>
2150

            
update pod
Yuki Kimoto authored on 2011-03-13
2151
    $dbi->insert(
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2152
        param  => {title => 'Perl', author => 'Ken'},
2153
        table  => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2154
    );
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2155
    
update pod
Yuki Kimoto authored on 2011-03-13
2156
Insert statement.
2157

            
2158
The following opitons are currently available.
2159

            
update pod
Yuki Kimoto authored on 2011-03-13
2160
=over 4
2161

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

            
2164
Insert data. This is hash reference.
2165

            
2166
    $dbi->insert(param => {title => 'Perl'});
2167

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

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

            
2172
=item C<table>
2173

            
2174
Table name.
2175

            
2176
    $dbi->insert(table => 'book');
2177

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

            
2180
Append statement to last of SQL. This is string.
2181

            
2182
    $dbi->insert(append => 'order by title');
2183

            
2184
=item C<filter>
2185

            
2186
Filter, executed before data is send to database. This is array reference.
2187
Filter value is code reference or
2188
filter name registerd by C<register_filter()>.
2189

            
2190
    # Basic
2191
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2192
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2193
            title  => sub { uc $_[0] }
2194
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2195
        }
update pod
Yuki Kimoto authored on 2011-03-13
2196
    );
2197
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2198
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2199
    $dbi->insert(
2200
        filter => [
2201
            [qw/title author/]  => sub { uc $_[0] }
2202
        ]
2203
    );
2204
    
2205
    # Filter name
2206
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2207
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2208
            title  => 'upper_case',
2209
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2210
        }
update pod
Yuki Kimoto authored on 2011-03-13
2211
    );
2212

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

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

            
2217
Get L<DBIx::Custom::Query> object instead of executing SQL.
2218
This is true or false value.
2219

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2226
=back
2227

            
2228
=over 4
2229

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2245
    lib / MyModel.pm
2246
        / MyModel / book.pm
2247
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2248

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

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

            
2253
    package MyModel;
2254
    
2255
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2256
    
2257
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2258

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2263
    package MyModel::book;
2264
    
2265
    use base 'MyModel';
2266
    
2267
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2268

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2271
    package MyModel::company;
2272
    
2273
    use base 'MyModel';
2274
    
2275
    1;
2276
    
2277
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2278

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

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

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

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

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

            
2290
Merge paramters.
2291

            
2292
$param:
2293

            
2294
    {key1 => [1, 1], key2 => 2}
2295

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

            
2298
    $dbi->method(
2299
        update_or_insert => sub {
2300
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2301
            
2302
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2303
        },
2304
        find_or_create   => sub {
2305
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2306
            
2307
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2308
        }
2309
    );
2310

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

            
2313
    $dbi->update_or_insert;
2314
    $dbi->find_or_create;
2315

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

            
2318
    $dbi->model('book')->method(
2319
        insert => sub { ... },
2320
        update => sub { ... }
2321
    );
2322
    
2323
    my $model = $dbi->model('book');
2324

            
2325
Set and get a L<DBIx::Custom::Model> object,
2326

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

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

            
2331
Create column clause for myself. The follwoing column clause is created.
2332

            
2333
    book.author as author,
2334
    book.title as title
2335

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2338
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2339
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2340
        user => 'ken',
2341
        password => '!LFKD%$&',
2342
        dbi_option => {mysql_enable_utf8 => 1}
2343
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2344

            
2345
Create a new L<DBIx::Custom> object.
2346

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

            
2349
    my $not_exists = $dbi->not_exists;
2350

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2354
=head2 C<register_filter>
2355

            
update pod
Yuki Kimoto authored on 2011-03-13
2356
    $dbi->register_filter(
2357
        # Time::Piece object to database DATE format
2358
        tp_to_date => sub {
2359
            my $tp = shift;
2360
            return $tp->strftime('%Y-%m-%d');
2361
        },
2362
        # database DATE format to Time::Piece object
2363
        date_to_tp => sub {
2364
           my $date = shift;
2365
           return Time::Piece->strptime($date, '%Y-%m-%d');
2366
        }
2367
    );
cleanup
yuki-kimoto authored on 2010-10-17
2368
    
update pod
Yuki Kimoto authored on 2011-03-13
2369
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2370

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2373
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2374
        table  => 'book',
2375
        column => ['author', 'title'],
2376
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2377
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2378
    
update pod
Yuki Kimoto authored on 2011-03-12
2379
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2380

            
2381
The following opitons are currently available.
2382

            
2383
=over 4
2384

            
2385
=item C<table>
2386

            
2387
Table name.
2388

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

            
2391
=item C<column>
2392

            
2393
Column clause. This is array reference or constant value.
2394

            
updated pod
Yuki Kimoto authored on 2011-06-07
2395
    # Array reference
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2396
    $dbi->select(column => ['author', 'title']);
2397
    
2398
    # Constant value
2399
    $dbi->select(column => 'author');
updated pod
Yuki Kimoto authored on 2011-06-07
2400
    
2401
Default is '*' if C<column> is not specified.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2402

            
2403
    # Default
2404
    $dbi->select(column => '*');
2405

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

            
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
2408
    # Hash reference EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-07
2409
    $dbi->select(column => [
2410
        {book => [qw/author title/]},
2411
        {person => [qw/name age/]}
2412
    ]);
2413

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

            
2416
    book.author as "book.author",
2417
    book.title as "book.title",
2418
    person.name as "person.name",
2419
    person.age as "person.age"
2420

            
2421
You can specify array reference in array refernce.
2422

            
2423
    $dbi->select(column => [
2424
        ['date(book.register_datetime)', as => 'book.register_date']
2425
    ]);
2426

            
2427
These is joined and quoted.
2428

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

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2433
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2434
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2435
    
2436
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2437
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2438
    
update pod
Yuki Kimoto authored on 2011-03-12
2439
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2440
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2441
        clause => ['and', 'author = :author', 'title like :title'],
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2442
        param  => {author => 'Ken', title => '%Perl%'}
2443
    );
update pod
Yuki Kimoto authored on 2011-03-12
2444
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2445

            
updated pod
Yuki Kimoto authored on 2011-04-25
2446
    # String(with where_param option)
2447
    $dbi->select(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2448
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2449
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2450
    );
2451
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2452
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2453

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

            
2456
    $dbi->select(join =>
2457
        [
2458
            'left outer join company on book.company_id = company_id',
2459
            'left outer join location on company.location_id = location.id'
2460
        ]
2461
    );
2462

            
2463
If column cluase or where clause contain table name like "company.name",
2464
needed join clause is used automatically.
2465

            
2466
    $dbi->select(
2467
        table => 'book',
2468
        column => ['company.location_id as company__location_id'],
2469
        where => {'company.name' => 'Orange'},
2470
        join => [
2471
            'left outer join company on book.company_id = company.id',
2472
            'left outer join location on company.location_id = location.id'
2473
        ]
2474
    );
2475

            
2476
In above select, the following SQL is created.
2477

            
2478
    select company.location_id as company__location_id
2479
    from book
2480
      left outer join company on book.company_id = company.id
2481
    where company.name = Orange
2482

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

            
2485
Parameter shown before where clause.
2486
    
2487
    $dbi->select(
2488
        table => 'table1',
2489
        column => 'table1.key1 as table1_key1, key2, key3',
2490
        where   => {'table1.key2' => 3},
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2491
        join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2492
                  ' as table2 on table1.key1 = table2.key1'],
2493
        param => {'table2.key3' => 5}
2494
    );
2495

            
2496
For example, if you want to contain tag in join clause, 
2497
you can pass parameter by C<param> option.
2498

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

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

            
2503
    $dbi->select(append => 'order by title');
updated pod
Yuki Kimoto authored on 2011-06-08
2504
    
2505
=item C<id>
2506

            
2507
Select using primary_key.
2508

            
2509
    $dbi->select(
2510
        primary_key => 'id',
2511
        id => 4,
2512
    );
2513

            
2514
    $dbi->select(
2515
        primary_key => ['id1', 'id2'],
2516
        id => [4, 5]
2517
    );
2518

            
2519
The above is same as the followin ones.
2520

            
2521
    $dbi->insert(where => {id => 4});
2522

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

            
2525
=item C<primary_key>
2526

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

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

            
2531
Wrap statement. This is array reference.
2532

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

            
2535
This option is for Oracle and SQL Server paging process.
2536

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

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

            
2543
    # Basic
2544
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2545
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2546
            title  => sub { uc $_[0] }
2547
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2548
        }
update pod
Yuki Kimoto authored on 2011-03-12
2549
    );
2550
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2551
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2552
    $dbi->select(
2553
        filter => [
2554
            [qw/title author/]  => sub { uc $_[0] }
2555
        ]
2556
    );
2557
    
2558
    # Filter name
2559
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2560
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2561
            title  => 'upper_case',
2562
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2563
        }
update pod
Yuki Kimoto authored on 2011-03-12
2564
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2565

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

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

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

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

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

            
2577
    my $sql = $query->sql;
2578

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

            
2581
Specify database data type.
2582

            
2583
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2584
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2585

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

            
2588
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2589

            
update pod
Yuki Kimoto authored on 2011-03-12
2590
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2591

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2594
    $dbi->update(
2595
        table  => 'book',
2596
        param  => {title => 'Perl'},
2597
        where  => {id => 4}
2598
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2599

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2604
=over 4
2605

            
2606
=item C<param>
2607

            
2608
Update data. This is hash reference.
2609

            
2610
    $dbi->update(param => {title => 'Perl'});
2611

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

            
2614
    $dbi->update(
2615
        {title => 'Perl'},
2616
        table => 'book',
2617
        where => {author => 'Ken'}
2618
    );
2619

            
2620
=item C<table>
2621

            
2622
Table name.
2623

            
2624
    $dbi->update(table => 'book');
2625

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2628
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2629
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2630
    
2631
    # Hash reference
2632
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2633
    
2634
    # DBIx::Custom::Where object
2635
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2636
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2637
        param  => {author => 'Ken', title => '%Perl%'}
2638
    );
2639
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2640
    
updated pod
Yuki Kimoto authored on 2011-04-25
2641
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2642
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2643
        param => {title => 'Perl'},
updated pod
Yuki Kimoto authored on 2011-06-08
2644
        where => 'id = :id',
updated pod
Yuki Kimoto authored on 2011-04-25
2645
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2646
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2647
    
update pod
Yuki Kimoto authored on 2011-03-13
2648
=item C<append>
2649

            
2650
Append statement to last of SQL. This is string.
2651

            
2652
    $dbi->update(append => 'order by title');
2653

            
2654
=item C<filter>
2655

            
2656
Filter, executed before data is send to database. This is array reference.
2657
Filter value is code reference or
2658
filter name registerd by C<register_filter()>.
2659

            
2660
    # Basic
2661
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2662
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2663
            title  => sub { uc $_[0] }
2664
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2665
        }
update pod
Yuki Kimoto authored on 2011-03-13
2666
    );
2667
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2668
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2669
    $dbi->update(
2670
        filter => [
2671
            [qw/title author/]  => sub { uc $_[0] }
2672
        ]
2673
    );
2674
    
2675
    # Filter name
2676
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2677
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2678
            title  => 'upper_case',
2679
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2680
        }
update pod
Yuki Kimoto authored on 2011-03-13
2681
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2682

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

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

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

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

            
2692
You can check SQL.
2693

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2698
    $dbi->insert(
2699
        primary_key => 'id',
2700
        id => 4,
2701
        param => {title => 'Perl', author => 'Ken'}
2702
    );
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2703

            
updated pod
Yuki Kimoto authored on 2011-06-08
2704
    $dbi->insert(
2705
        primary_key => ['id1', 'id2'],
2706
        id => [4, 5],
2707
        param => {title => 'Perl', author => 'Ken'}
2708
    );
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2709

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

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

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

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2738
    $dbi->update(
2739
        where => {id => 4}
2740
        param => {title => 'Perl', author => 'Ken'}
2741
    );
update pod
Yuki Kimoto authored on 2011-03-13
2742

            
updated pod
Yuki Kimoto authored on 2011-06-08
2743
    $dbi->update(
2744
        where => {id1 => 4, id2 => 5},
2745
        param => {title => 'Perl', author => 'Ken'}
2746
    );
update pod
Yuki Kimoto authored on 2011-03-13
2747

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2752
=back
update pod
Yuki Kimoto authored on 2011-03-13
2753

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

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

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

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

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

            
2765
Create update parameter tag.
2766

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

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

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

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

            
2778
Create a new L<DBIx::Custom::Where> object.
2779

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

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

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

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

            
2789
Update statement, using primary key.
2790

            
2791
    $dbi->update_at(
2792
        table => 'book',
2793
        primary_key => 'id',
2794
        where => '5',
2795
        param => {title => 'Perl'}
2796
    );
2797

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

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

            
2804
Delete statement, using primary key.
2805

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

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

            
2816
=head2 C<select_at()> DEPRECATED!
2817

            
2818
Select statement, using primary key.
2819

            
2820
    $dbi->select_at(
2821
        table => 'book',
2822
        primary_key => 'id',
2823
        where => '5'
2824
    );
2825

            
2826
This method is same as C<select()> exept that
2827
C<primary_key> is specified and C<where> is constant value or array refrence.
2828
all option of C<select()> is available.
2829

            
2830
=head2 C<register_tag> DEPRECATED!
2831

            
2832
    $dbi->register_tag(
2833
        update => sub {
2834
            my @columns = @_;
2835
            
2836
            # Update parameters
2837
            my $s = 'set ';
2838
            $s .= "$_ = ?, " for @columns;
2839
            $s =~ s/, $//;
2840
            
2841
            return [$s, \@columns];
2842
        }
2843
    );
2844

            
2845
Register tag, used by C<execute()>.
2846

            
2847
See also L<Tags/Tags> about tag registered by default.
2848

            
2849
Tag parser receive arguments specified in tag.
2850
In the following tag, 'title' and 'author' is parser arguments
2851

            
2852
    {update_param title author} 
2853

            
2854
Tag parser must return array refrence,
2855
first element is the result statement, 
2856
second element is column names corresponding to place holders.
2857

            
2858
In this example, result statement is 
2859

            
2860
    set title = ?, author = ?
2861

            
2862
Column names is
2863

            
2864
    ['title', 'author']
2865

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2866
=head1 Parameter
2867

            
2868
Parameter start at ':'. This is replaced to place holoder
2869

            
2870
    $dbi->execute(
2871
        "select * from book where title = :title and author = :author"
2872
        param => {title => 'Perl', author => 'Ken'}
2873
    );
2874

            
2875
    "select * from book where title = ? and author = ?"
2876

            
2877
=head1 Tags DEPRECATED!
2878

            
2879
B<Tag> system is DEPRECATED! use parameter system :name instead.
2880
Parameter is simple and readable.
2881

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

            
2884
The following tags is available.
2885

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

            
2888
Placeholder tag.
2889

            
2890
    {? NAME}    ->   ?
2891

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

            
2894
Equal tag.
2895

            
2896
    {= NAME}    ->   NAME = ?
2897

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

            
2900
Not equal tag.
2901

            
2902
    {<> NAME}   ->   NAME <> ?
2903

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

            
2906
Lower than tag
2907

            
2908
    {< NAME}    ->   NAME < ?
2909

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

            
2912
Greater than tag
2913

            
2914
    {> NAME}    ->   NAME > ?
2915

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

            
2918
Greater than or equal tag
2919

            
2920
    {>= NAME}   ->   NAME >= ?
2921

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

            
2924
Lower than or equal tag
2925

            
2926
    {<= NAME}   ->   NAME <= ?
2927

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

            
2930
Like tag
2931

            
2932
    {like NAME}   ->   NAME like ?
2933

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

            
2936
In tag.
2937

            
2938
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2939

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

            
2942
Insert parameter tag.
2943

            
2944
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2945

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

            
2948
Updata parameter tag.
2949

            
2950
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2951

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

            
2954
Insert statement, using primary key.
2955

            
2956
    $dbi->insert_at(
2957
        table => 'book',
2958
        primary_key => 'id',
2959
        where => '5',
2960
        param => {title => 'Perl'}
2961
    );
2962

            
2963
This method is same as C<insert()> exept that
2964
C<primary_key> is specified and C<where> is constant value or array refrence.
2965
all option of C<insert()> is available.
2966

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

            
2969
=head2 C<DBIX_CUSTOM_DEBUG>
2970

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

            
2974
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2975

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

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

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

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

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

            
2987
C<< <kimoto.yuki at gmail.com> >>
2988

            
2989
L<http://github.com/yuki-kimoto/DBIx-Custom>
2990

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2991
=head1 AUTHOR
2992

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

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

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

            
2999
This program is free software; you can redistribute it and/or modify it
3000
under the same terms as Perl itself.
3001

            
3002
=cut