DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
3042 lines | 75.919kb
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
    }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
489

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

            
596
        return $result;
597
    }
cleanup
Yuki Kimoto authored on 2011-04-02
598
    
599
    # Not select statement
600
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
601
}
602

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

            
cleanup
yuki-kimoto authored on 2010-10-17
605
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
606
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
607
    
cleanup
yuki-kimoto authored on 2010-10-17
608
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
609
    my $param;
610
    $param = shift if @_ % 2;
611
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
612
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
613
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
614
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
615
    my $p = delete $args{param} || {};
616
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
617
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
618
    my $query_return  = delete $args{query};
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
619
    my $id = delete $args{id};
620
    my $primary_key = delete $args{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
621
    croak "insert method primary_key option " .
added tests
Yuki Kimoto authored on 2011-06-08
622
          "must be specified when id is specified " . _subname
623
      if defined $id && !defined $primary_key;
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
624
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
625

            
626
    # Check arguments
627
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
628
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
629
          unless $INSERT_ARGS{$name};
630
    }
631

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
632
    # Merge parameter
633
    if ($id) {
cleanup
Yuki Kimoto authored on 2011-06-08
634
        my $id_param = $self->_create_param_from_id($id, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
635
        $param = $self->merge_param($id_param, $param);
636
    }
637

            
cleanup
Yuki Kimoto authored on 2011-04-02
638
    # Reserved word quote
639
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
640
    
cleanup
Yuki Kimoto authored on 2011-04-02
641
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
642
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
643
    push @sql, "insert into $q$table$q " . $self->insert_param($param);
cleanup
Yuki Kimoto authored on 2011-01-27
644
    push @sql, $append if $append;
645
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
646
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
647
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
648
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
649
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
650
    
packaging one directory
yuki-kimoto authored on 2009-11-16
651
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
652
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
653
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
654
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
655
        table => $table,
656
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
657
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
658
}
659

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

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
681
sub include_model {
682
    my ($self, $name_space, $model_infos) = @_;
683
    
cleanup
Yuki Kimoto authored on 2011-04-02
684
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
685
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
686
    
687
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
688
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
689

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
770
sub method {
771
    my $self = shift;
772
    
cleanup
Yuki Kimoto authored on 2011-04-02
773
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
774
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
775
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
776
    
777
    return $self;
778
}
779

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

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

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

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

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

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

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

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
994
sub setup_model {
995
    my $self = shift;
996
    
cleanup
Yuki Kimoto authored on 2011-04-02
997
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
998
    $self->each_column(
999
        sub {
1000
            my ($self, $table, $column, $column_info) = @_;
1001
            if (my $model = $self->models->{$table}) {
1002
                push @{$model->columns}, $column;
1003
            }
1004
        }
1005
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1006
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1007
}
1008

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1009
sub type_rule {
1010
    my $self = shift;
1011
    
1012
    if (@_) {
1013
        my $type_rule = _array_to_hash([@_]);
1014
        $self->{type_rule} = $type_rule;
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
1015
        $self->{_into} ||= {};
1016
        $self->each_column(sub {
1017
            my ($dbi, $table, $column, $column_info) = @_;
1018
            
1019
            my $type = $column_info->{TYPE_NAME};
1020
            if ($type_rule->{$type} &&
1021
                (my $rule = $type_rule->{$type}->{into}))
1022
            {
1023
                $self->{_into}{$table}{$column} = $rule;
1024
            }
1025
        });
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1026
        
1027
        return $self;
1028
    }
1029
    
1030
    return $self->{type_rule} || {};
1031
}
1032

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1039
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1040
    my $param;
1041
    $param = shift if @_ % 2;
1042
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
1043
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
1044
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
1045
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1046
    my $p = delete $args{param} || {};
1047
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
1048
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1049
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
1050
    my $append           = delete $args{append} || '';
1051
    my $allow_update_all = delete $args{allow_update_all};
cleanup
Yuki Kimoto authored on 2011-06-08
1052
    my $id = delete $args{id};
1053
    my $primary_key = delete $args{primary_key};
1054
    croak "update method primary_key option " .
1055
          "must be specified when id is specified " . _subname
1056
      if defined $id && !defined $primary_key;
1057
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
version 0.0901
yuki-kimoto authored on 2009-12-17
1058
    
cleanup
Yuki Kimoto authored on 2011-04-02
1059
    # Check argument names
1060
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1061
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1062
          unless $UPDATE_ARGS{$name};
1063
    }
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1064

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

            
1068
    # Where
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1069
    $where = $self->_create_param_from_id($id, $primary_key) if $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1070
    my $where_clause = '';
1071
    if (ref $where) {
1072
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1073
        $where_param = keys %$where_param
1074
                     ? $self->merge_param($where_param, $where->param)
1075
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1076
        
1077
        # String where
1078
        $where_clause = $where->to_string;
1079
    }
1080
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1081
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1082
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1083
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1084
    # Merge param
1085
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1086
    
cleanup
Yuki Kimoto authored on 2011-04-02
1087
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1088
    my @sql;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1089
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
1090
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1091
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1092
    
cleanup
Yuki Kimoto authored on 2011-01-27
1093
    # SQL
1094
    my $sql = join(' ', @sql);
1095
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1096
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1097
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1098
    return $query if $args{query};
1099
    
cleanup
yuki-kimoto authored on 2010-10-17
1100
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1101
    my $ret_val = $self->execute(
1102
        $query,
1103
        param  => $param, 
1104
        table => $table,
1105
        %args
1106
    );
cleanup
yuki-kimoto authored on 2010-10-17
1107
    
1108
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1109
}
1110

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1113
sub update_param {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1114
    my ($self, $param, $opt) = @_;
1115
    
cleanup
Yuki Kimoto authored on 2011-04-02
1116
    # Create update parameter tag
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1117
    my $tag = $self->assign_param($param);
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1118
    $tag = "set $tag" unless $opt->{no_set};
1119

            
cleanup
Yuki Kimoto authored on 2011-04-02
1120
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1121
}
1122

            
cleanup
Yuki Kimoto authored on 2011-01-25
1123
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1124
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1125
    
1126
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1127
    return DBIx::Custom::Where->new(
1128
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1129
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1130
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1131
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1132
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1133
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1134

            
cleanup
Yuki Kimoto authored on 2011-04-02
1135
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1136
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1137
    
cleanup
Yuki Kimoto authored on 2011-04-02
1138
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1139
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1140
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1141
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1142
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1143
        
1144
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1145
        my $value;
1146
        if(ref $params->{$column} eq 'ARRAY') {
1147
            my $i = $count->{$column} || 0;
1148
            $i += $not_exists->{$column} || 0;
1149
            my $found;
1150
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1151
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1152
                    $not_exists->{$column}++;
1153
                }
1154
                else  {
1155
                    $value = $params->{$column}->[$k];
1156
                    $found = 1;
1157
                    last
1158
                }
1159
            }
1160
            next unless $found;
1161
        }
1162
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1163
        
cleanup
Yuki Kimoto authored on 2011-01-12
1164
        # Filter
1165
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1166
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1167
        # Type
1168
        push @$bind, {
1169
            value => $f ? $f->($value) : $value,
1170
            type => $type->{$column}
1171
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1172
        
1173
        # Count up 
1174
        $count->{$column}++;
1175
    }
1176
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1177
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1178
}
1179

            
cleanup
Yuki Kimoto authored on 2011-06-08
1180
sub _create_param_from_id {
1181
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1182
    
cleanup
Yuki Kimoto authored on 2011-06-08
1183
    # Create parameter
1184
    my $param = {};
1185
    if ($id) {
1186
        $id = [$id] unless ref $id;
1187
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1188
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1189
          unless !ref $id || ref $id eq 'ARRAY';
1190
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1191
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1192
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1193
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1194
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1195
        }
1196
    }
1197
    
cleanup
Yuki Kimoto authored on 2011-06-08
1198
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1199
}
1200

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1201
sub _connect {
1202
    my $self = shift;
1203
    
1204
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1205
    my $dsn = $self->data_source;
1206
    warn "data_source is DEPRECATED! use dsn instead\n";
1207
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1208
    croak qq{"dsn" must be specified } . _subname
1209
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1210
    my $user        = $self->user;
1211
    my $password    = $self->password;
1212
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1213
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1214
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1215
    
1216
    # Connect
1217
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1218
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1219
        $user,
1220
        $password,
1221
        {
1222
            %{$self->default_dbi_option},
1223
            %$dbi_option
1224
        }
1225
    )};
1226
    
1227
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1228
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1229
    
1230
    return $dbh;
1231
}
1232

            
cleanup
yuki-kimoto authored on 2010-10-17
1233
sub _croak {
1234
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1235
    
1236
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1237
    $append ||= "";
1238
    
1239
    # Verbose
1240
    if ($Carp::Verbose) { croak $error }
1241
    
1242
    # Not verbose
1243
    else {
1244
        
1245
        # Remove line and module infromation
1246
        my $at_pos = rindex($error, ' at ');
1247
        $error = substr($error, 0, $at_pos);
1248
        $error =~ s/\s+$//;
1249
        croak "$error$append";
1250
    }
1251
}
1252

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1253
sub _need_tables {
1254
    my ($self, $tree, $need_tables, $tables) = @_;
1255
    
cleanup
Yuki Kimoto authored on 2011-04-02
1256
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1257
    foreach my $table (@$tables) {
1258
        if ($tree->{$table}) {
1259
            $need_tables->{$table} = 1;
1260
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1261
        }
1262
    }
1263
}
1264

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1265
sub _push_join {
1266
    my ($self, $sql, $join, $join_tables) = @_;
1267
    
cleanup
Yuki Kimoto authored on 2011-04-02
1268
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1269
    return unless @$join;
1270
    
cleanup
Yuki Kimoto authored on 2011-04-02
1271
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1272
    my $tree = {};
cleanup
Yuki Kimoto authored on 2011-04-02
1273
    my $q = $self->reserved_word_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1274
    for (my $i = 0; $i < @$join; $i++) {
1275
        
cleanup
Yuki Kimoto authored on 2011-04-02
1276
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1277
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1278
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1279
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1280
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1281
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1282
            my $table1 = $1;
1283
            my $table2 = $2;
cleanup
Yuki Kimoto authored on 2011-04-25
1284
            croak qq{right side table of "$join_clause" must be unique }
1285
                . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1286
              if exists $tree->{$table2};
1287
            $tree->{$table2}
1288
              = {position => $i, parent => $table1, join => $join_clause};
1289
        }
1290
        else {
cleanup
Yuki Kimoto authored on 2011-04-25
1291
            croak qq{join "$join_clause" must be two table name } . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1292
        }
1293
    }
1294
    
cleanup
Yuki Kimoto authored on 2011-04-02
1295
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1296
    my $need_tables = {};
1297
    $self->_need_tables($tree, $need_tables, $join_tables);
1298
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1299
    
1300
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1301
    foreach my $need_table (@need_tables) {
1302
        push @$sql, $tree->{$need_table}{join};
1303
    }
1304
}
cleanup
Yuki Kimoto authored on 2011-03-08
1305

            
cleanup
Yuki Kimoto authored on 2011-04-02
1306
sub _remove_duplicate_table {
1307
    my ($self, $tables, $main_table) = @_;
1308
    
1309
    # Remove duplicate table
1310
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1311
    delete $tables{$main_table} if $main_table;
1312
    
1313
    return [keys %tables, $main_table ? $main_table : ()];
1314
}
1315

            
cleanup
Yuki Kimoto authored on 2011-04-02
1316
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1317
    my ($self, $source) = @_;
1318
    
cleanup
Yuki Kimoto authored on 2011-04-02
1319
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1320
    my $tables = [];
1321
    my $safety_character = $self->safety_character;
1322
    my $q = $self->reserved_word_quote;
1323
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1324
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1325
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1326
    while ($source =~ /$table_re/g) {
1327
        push @$tables, $1;
1328
    }
1329
    
1330
    return $tables;
1331
}
1332

            
cleanup
Yuki Kimoto authored on 2011-04-02
1333
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1334
    my ($self, $where) = @_;
1335
    
cleanup
Yuki Kimoto authored on 2011-04-02
1336
    my $obj;
1337
    
1338
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1339
    if (ref $where eq 'HASH') {
1340
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1341
        my $q = $self->reserved_word_quote;
1342
        foreach my $column (keys %$where) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1343
            my $column_quote = "$q$column$q";
1344
            $column_quote =~ s/\./$q.$q/;
1345
            push @$clause, "$column_quote = :$column" for keys %$where;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1346
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1347
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1348
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1349
    
1350
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1351
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1352
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1353
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1354
    
1355
    # Array(DEPRECATED!)
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1356
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1357
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1358
             "use \$dbi->select(where => \$dbi->where(clause => " .
added warnings
Yuki Kimoto authored on 2011-06-07
1359
             "CLAUSE, where_param => PARAMETER));";
cleanup
Yuki Kimoto authored on 2011-04-02
1360
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1361
            clause => $where->[0],
1362
            param  => $where->[1]
1363
        );
1364
    }
1365
    
cleanup
Yuki Kimoto authored on 2011-04-02
1366
    # Check where argument
improved error messages
Yuki Kimoto authored on 2011-04-18
1367
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1368
        . qq{or array reference, which contains where clause and paramter}
cleanup
Yuki Kimoto authored on 2011-04-25
1369
        . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1370
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1371
    
cleanup
Yuki Kimoto authored on 2011-04-02
1372
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1373
}
1374

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

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
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
    my $param = delete $args{param};
1387
    
1388
    # Check arguments
1389
    foreach my $name (keys %args) {
1390
        croak qq{"$name" is wrong option } . _subname
1391
          unless $SELECT_AT_ARGS{$name};
1392
    }
1393
    
1394
    # Table
1395
    croak qq{"table" option must be specified } . _subname
1396
      unless $args{table};
1397
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1398
    
1399
    # Create where parameter
1400
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1401
    
1402
    return $self->select(where => $where_param, %args);
1403
}
1404

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1405
# DEPRECATED!
1406
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1407
sub delete_at {
1408
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1409

            
1410
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1411
    
1412
    # Arguments
1413
    my $primary_keys = delete $args{primary_key};
1414
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1415
    my $where = delete $args{where};
1416
    
1417
    # Check arguments
1418
    foreach my $name (keys %args) {
1419
        croak qq{"$name" is wrong option } . _subname
1420
          unless $DELETE_AT_ARGS{$name};
1421
    }
1422
    
1423
    # Create where parameter
1424
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1425
    
1426
    return $self->delete(where => $where_param, %args);
1427
}
1428

            
cleanup
Yuki Kimoto authored on 2011-06-08
1429
# DEPRECATED!
1430
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1431
sub update_at {
1432
    my $self = shift;
1433

            
1434
    warn "update_at is DEPRECATED! use update and id option instead";
1435
    
1436
    # Arguments
1437
    my $param;
1438
    $param = shift if @_ % 2;
1439
    my %args = @_;
1440
    my $primary_keys = delete $args{primary_key};
1441
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1442
    my $where = delete $args{where};
1443
    my $p = delete $args{param} || {};
1444
    $param  ||= $p;
1445
    
1446
    # Check arguments
1447
    foreach my $name (keys %args) {
1448
        croak qq{"$name" is wrong option } . _subname
1449
          unless $UPDATE_AT_ARGS{$name};
1450
    }
1451
    
1452
    # Create where parameter
1453
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1454
    
1455
    return $self->update(where => $where_param, param => $param, %args);
1456
}
1457

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1458
# DEPRECATED!
1459
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
1460
sub insert_at {
1461
    my $self = shift;
1462
    
1463
    warn "insert_at is DEPRECATED! use insert and id option instead";
1464
    
1465
    # Arguments
1466
    my $param;
1467
    $param = shift if @_ % 2;
1468
    my %args = @_;
1469
    my $primary_key = delete $args{primary_key};
1470
    $primary_key = [$primary_key] unless ref $primary_key;
1471
    my $where = delete $args{where};
1472
    my $p = delete $args{param} || {};
1473
    $param  ||= $p;
1474
    
1475
    # Check arguments
1476
    foreach my $name (keys %args) {
1477
        croak qq{"$name" is wrong option } . _subname
1478
          unless $INSERT_AT_ARGS{$name};
1479
    }
1480
    
1481
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1482
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1483
    $param = $self->merge_param($where_param, $param);
1484
    
1485
    return $self->insert(param => $param, %args);
1486
}
1487

            
added warnings
Yuki Kimoto authored on 2011-06-07
1488
# DEPRECATED!
1489
sub register_tag {
1490
    warn "register_tag is DEPRECATED!";
1491
    shift->query_builder->register_tag(@_)
1492
}
1493

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1494
# DEPRECATED!
1495
__PACKAGE__->attr('data_source');
1496

            
cleanup
Yuki Kimoto authored on 2011-01-25
1497
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1498
__PACKAGE__->attr(
1499
    dbi_options => sub { {} },
1500
    filter_check  => 1
1501
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1502

            
cleanup
Yuki Kimoto authored on 2011-01-25
1503
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1504
sub default_bind_filter {
1505
    my $self = shift;
1506
    
added warnings
Yuki Kimoto authored on 2011-06-07
1507
    warn "default_bind_filter is DEPRECATED! use apply_filter instead\n";
1508
    
cleanup
Yuki Kimoto authored on 2011-01-12
1509
    if (@_) {
1510
        my $fname = $_[0];
1511
        
1512
        if (@_ && !$fname) {
1513
            $self->{default_out_filter} = undef;
1514
        }
1515
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1516
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1517
              unless exists $self->filters->{$fname};
1518
        
1519
            $self->{default_out_filter} = $self->filters->{$fname};
1520
        }
1521
        return $self;
1522
    }
1523
    
1524
    return $self->{default_out_filter};
1525
}
1526

            
cleanup
Yuki Kimoto authored on 2011-01-25
1527
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1528
sub default_fetch_filter {
1529
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1530

            
1531
    warn "default_fetch_filter is DEPRECATED! use apply_filter instead\n";
cleanup
Yuki Kimoto authored on 2011-01-12
1532
    
1533
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1534
        my $fname = $_[0];
1535

            
cleanup
Yuki Kimoto authored on 2011-01-12
1536
        if (@_ && !$fname) {
1537
            $self->{default_in_filter} = undef;
1538
        }
1539
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1540
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1541
              unless exists $self->filters->{$fname};
1542
        
1543
            $self->{default_in_filter} = $self->filters->{$fname};
1544
        }
1545
        
1546
        return $self;
1547
    }
1548
    
many changed
Yuki Kimoto authored on 2011-01-23
1549
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1550
}
1551

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1552
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1553
sub insert_param_tag {
1554
    warn "insert_param_tag is DEPRECATED! " .
1555
         "use insert_param instead!";
1556
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1557
}
1558

            
cleanup
Yuki Kimoto authored on 2011-01-25
1559
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1560
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1561
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1562
    return shift->query_builder->register_tag_processor(@_);
1563
}
1564

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1565
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1566
sub update_param_tag {
1567
    warn "update_param is DEPRECATED! " .
1568
         "use update_param instead";
1569
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1570
}
cleanup
Yuki Kimoto authored on 2011-03-08
1571
# DEPRECATED!
1572
sub _push_relation {
1573
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1574
    
1575
    if (keys %{$relation || {}}) {
1576
        push @$sql, $need_where ? 'where' : 'and';
1577
        foreach my $rcolumn (keys %$relation) {
1578
            my $table1 = (split (/\./, $rcolumn))[0];
1579
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1580
            push @$tables, ($table1, $table2);
1581
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1582
        }
1583
    }
1584
    pop @$sql if $sql->[-1] eq 'and';    
1585
}
1586

            
1587
# DEPRECATED!
1588
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1589
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1590
    
1591
    if (keys %{$relation || {}}) {
1592
        foreach my $rcolumn (keys %$relation) {
1593
            my $table1 = (split (/\./, $rcolumn))[0];
1594
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1595
            my $table1_exists;
1596
            my $table2_exists;
1597
            foreach my $table (@$tables) {
1598
                $table1_exists = 1 if $table eq $table1;
1599
                $table2_exists = 1 if $table eq $table2;
1600
            }
1601
            unshift @$tables, $table1 unless $table1_exists;
1602
            unshift @$tables, $table2 unless $table2_exists;
1603
        }
1604
    }
1605
}
1606

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1609
=head1 NAME
1610

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

            
1613
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1614

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1615
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1616
    
1617
    # Connect
1618
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1619
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1620
        user => 'ken',
1621
        password => '!LFKD%$&',
1622
        dbi_option => {mysql_enable_utf8 => 1}
1623
    );
cleanup
yuki-kimoto authored on 2010-08-05
1624

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1625
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1626
    $dbi->insert(
1627
        table  => 'book',
1628
        param  => {title => 'Perl', author => 'Ken'}
1629
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1630
    
1631
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1632
    $dbi->update(
1633
        table  => 'book', 
1634
        param  => {title => 'Perl', author => 'Ken'}, 
1635
        where  => {id => 5},
1636
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1637
    
1638
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1639
    $dbi->delete(
1640
        table  => 'book',
1641
        where  => {author => 'Ken'},
1642
    );
cleanup
yuki-kimoto authored on 2010-08-05
1643

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1650
    # Select, more complex
1651
    my $result = $dbi->select(
1652
        table  => 'book',
1653
        column => [
1654
            'book.author as book__author',
1655
            'company.name as company__name'
1656
        ],
1657
        where  => {'book.author' => 'Ken'},
1658
        join => ['left outer join company on book.company_id = company.id'],
1659
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1660
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1661
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1662
    # Fetch
1663
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1664
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1665
    }
1666
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1667
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1668
    while (my $row = $result->fetch_hash) {
1669
        
1670
    }
1671
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1672
    # Execute SQL with parameter.
1673
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1674
        "select id from book where author = :author and title like :title",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1675
        param  => {author => 'ken', title => '%Perl%'}
1676
    );
1677
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1678
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1679

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

            
1682
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1683

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1693
=item *
1694

            
1695
Filter when data is send or receive.
1696

            
1697
=item *
1698

            
1699
Data filtering system
1700

            
1701
=item *
1702

            
1703
Model support.
1704

            
1705
=item *
1706

            
1707
Generate where clause dinamically.
1708

            
1709
=item *
1710

            
1711
Generate join clause dinamically.
1712

            
1713
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1714

            
1715
=head1 GUIDE
1716

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

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

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

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

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

            
1727
    my $connector = $dbi->connector;
1728
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1729

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

            
1733
This is L<DBIx::Connector> example. Please pass
1734
C<default_dbi_option> to L<DBIx::Connector>.
1735

            
1736
    my $connector = DBIx::Connector->new(
1737
        "dbi:mysql:database=$DATABASE",
1738
        $USER,
1739
        $PASSWORD,
1740
        DBIx::Custom->new->default_dbi_option
1741
    );
1742
    
1743
    my $dbi = DBIx::Custom->new(connector => $connector);
1744

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

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

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

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

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

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

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

            
1762
=head2 C<default_dbi_option>
1763

            
1764
    my $default_dbi_option = $dbi->default_dbi_option;
1765
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1766

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1770
    {
1771
        RaiseError => 1,
1772
        PrintError => 0,
1773
        AutoCommit => 1,
1774
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1775

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

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

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

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

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

            
1788
    my $models = $dbi->models;
1789
    $dbi       = $dbi->models(\%models);
1790

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1793
=head2 C<password>
1794

            
1795
    my $password = $dbi->password;
1796
    $dbi         = $dbi->password('lkj&le`@s');
1797

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

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

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

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

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

            
1809
     my reserved_word_quote = $dbi->reserved_word_quote;
1810
     $dbi                   = $dbi->reserved_word_quote('"');
1811

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1831
    my $user = $dbi->user;
1832
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1833

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1844
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1845
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1846
        'issue_date' => {
1847
            out => 'tp_to_date',
1848
            in  => 'date_to_tp',
1849
            end => 'tp_to_displaydate'
1850
        },
1851
        'write_date' => {
1852
            out => 'tp_to_date',
1853
            in  => 'date_to_tp',
1854
            end => 'tp_to_displaydate'
1855
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1856
    );
1857

            
update pod
Yuki Kimoto authored on 2011-03-13
1858
Apply filter to columns.
1859
C<out> filter is executed before data is send to database.
1860
C<in> filter is executed after a row is fetch.
1861
C<end> filter is execute after C<in> filter is executed.
1862

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1865
       PETTERN         EXAMPLE
1866
    1. Column        : author
1867
    2. Table.Column  : book.author
1868
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1869

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

            
1873
You can set multiple filters at once.
1874

            
1875
    $dbi->apply_filter(
1876
        'book',
1877
        [qw/issue_date write_date/] => {
1878
            out => 'tp_to_date',
1879
            in  => 'date_to_tp',
1880
            end => 'tp_to_displaydate'
1881
        }
1882
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1883

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

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

            
1888
Create assign tag.
1889

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

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

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

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

            
1898
Create column clause. The follwoing column clause is created.
1899

            
1900
    book.author as "book.author",
1901
    book.title as "book.title"
1902

            
1903
=head2 C<column> EXPERIMETNAL
1904

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

            
1907
Create column clause. The follwoing column clause is created.
1908

            
1909
    book.author as book__author,
1910
    book.title as book__title
1911

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1914
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1915
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1916
        user => 'ken',
1917
        password => '!LFKD%$&',
1918
        dbi_option => {mysql_enable_utf8 => 1}
1919
    );
1920

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1929
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1930
        table => 'book',
1931
        primary_key => 'id',
1932
        join => [
1933
            'inner join company on book.comparny_id = company.id'
1934
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1935
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1936
            publish_date => {
1937
                out => 'tp_to_date',
1938
                in => 'date_to_tp',
1939
                end => 'tp_to_displaydate'
1940
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1941
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1942
    );
1943

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

            
1947
   $dbi->model('book')->select(...);
1948

            
cleanup
yuki-kimoto authored on 2010-10-17
1949
=head2 C<create_query>
1950
    
1951
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1952
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1953
    );
update document
yuki-kimoto authored on 2009-11-19
1954

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

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

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

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

            
1965
    my $dbh = $dbi->dbh;
1966

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

            
1970
=head2 C<each_column>
1971

            
1972
    $dbi->each_column(
1973
        sub {
1974
            my ($dbi, $table, $column, $column_info) = @_;
1975
            
1976
            my $type = $column_info->{TYPE_NAME};
1977
            
1978
            if ($type eq 'DATE') {
1979
                # ...
1980
            }
1981
        }
1982
    );
1983

            
1984
Iterate all column informations of all table from database.
1985
Argument is callback when one column is found.
1986
Callback receive four arguments, dbi object, table name,
1987
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1988

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

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

            
1996
Execute SQL, containing tags.
1997
Return value is L<DBIx::Custom::Result> in select statement, or
1998
the count of affected rows in insert, update, delete statement.
1999

            
2000
Tag is turned into the statement containing place holder
2001
before SQL is executed.
2002

            
2003
    select * from where title = ? and author like ?;
2004

            
2005
See also L<Tags/Tags>.
2006

            
2007
The following opitons are currently available.
2008

            
2009
=over 4
2010

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

            
2013
Table names for filtering.
2014

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

            
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2017
C<execute()> is unlike C<insert()>, C<update()>, C<delete()>, C<select()>,
improved table search in col...
Yuki Kimoto authored on 2011-04-12
2018
Filtering is off because we don't know what filter is applied.
2019

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

            
2022
Filter, executed before data is send to database. This is array reference.
2023
Filter value is code reference or
2024
filter name registerd by C<register_filter()>.
2025

            
2026
    # Basic
2027
    $dbi->execute(
2028
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2029
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2030
            title  => sub { uc $_[0] }
2031
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2032
        }
update pod
Yuki Kimoto authored on 2011-03-13
2033
    );
2034
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2035
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2036
    $dbi->execute(
2037
        $sql,
2038
        filter => [
2039
            [qw/title author/]  => sub { uc $_[0] }
2040
        ]
2041
    );
2042
    
2043
    # Filter name
2044
    $dbi->execute(
2045
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2046
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2047
            title  => 'upper_case',
2048
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2049
        }
update pod
Yuki Kimoto authored on 2011-03-13
2050
    );
2051

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

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

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

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

            
2060
Delete statement.
2061

            
2062
The following opitons are currently available.
2063

            
update pod
Yuki Kimoto authored on 2011-03-13
2064
=over 4
2065

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

            
2068
Table name.
2069

            
2070
    $dbi->delete(table => 'book');
2071

            
2072
=item C<where>
2073

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2074
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2075
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
2076
    
2077
    # Hash reference
2078
    $dbi->delete(where => {title => 'Perl'});
2079
    
2080
    # DBIx::Custom::Where object
2081
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2082
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2083
        param  => {author => 'Ken', title => '%Perl%'}
2084
    );
2085
    $dbi->delete(where => $where);
2086

            
updated pod
Yuki Kimoto authored on 2011-04-25
2087
    # String(with where_param option)
2088
    $dbi->delete(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2089
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2090
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2091
    );
2092
    
update pod
Yuki Kimoto authored on 2011-03-13
2093
=item C<append>
2094

            
2095
Append statement to last of SQL. This is string.
2096

            
2097
    $dbi->delete(append => 'order by title');
2098

            
2099
=item C<filter>
2100

            
2101
Filter, executed before data is send to database. This is array reference.
2102
Filter value is code reference or
2103
filter name registerd by C<register_filter()>.
2104

            
2105
    # Basic
2106
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2107
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2108
            title  => sub { uc $_[0] }
2109
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2110
        }
update pod
Yuki Kimoto authored on 2011-03-13
2111
    );
2112
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2113
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2114
    $dbi->delete(
2115
        filter => [
2116
            [qw/title author/]  => sub { uc $_[0] }
2117
        ]
2118
    );
2119
    
2120
    # Filter name
2121
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2122
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2123
            title  => 'upper_case',
2124
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2125
        }
update pod
Yuki Kimoto authored on 2011-03-13
2126
    );
2127

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

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

            
2132
Get L<DBIx::Custom::Query> object instead of executing SQL.
2133
This is true or false value.
2134

            
2135
    my $query = $dbi->delete(query => 1);
2136

            
2137
You can check SQL.
2138

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2145
    $dbi->delete(
update pod
Yuki Kimoto authored on 2011-03-13
2146
        primary_key => 'id',
updated pod
Yuki Kimoto authored on 2011-06-08
2147
        id => 4,
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2148
    );
2149

            
updated pod
Yuki Kimoto authored on 2011-06-08
2150
    $dbi->delete(
2151
        primary_key => ['id1', 'id2'],
2152
        id => [4, 5],
2153
    );
update pod
Yuki Kimoto authored on 2011-03-13
2154

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2165
=back
update pod
Yuki Kimoto authored on 2011-03-13
2166

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2174
=head2 C<insert>
2175

            
update pod
Yuki Kimoto authored on 2011-03-13
2176
    $dbi->insert(
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2177
        param  => {title => 'Perl', author => 'Ken'},
2178
        table  => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2179
    );
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2180
    
update pod
Yuki Kimoto authored on 2011-03-13
2181
Insert statement.
2182

            
2183
The following opitons are currently available.
2184

            
update pod
Yuki Kimoto authored on 2011-03-13
2185
=over 4
2186

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

            
2189
Insert data. This is hash reference.
2190

            
2191
    $dbi->insert(param => {title => 'Perl'});
2192

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

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

            
2197
=item C<table>
2198

            
2199
Table name.
2200

            
2201
    $dbi->insert(table => 'book');
2202

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

            
2205
Append statement to last of SQL. This is string.
2206

            
2207
    $dbi->insert(append => 'order by title');
2208

            
2209
=item C<filter>
2210

            
2211
Filter, executed before data is send to database. This is array reference.
2212
Filter value is code reference or
2213
filter name registerd by C<register_filter()>.
2214

            
2215
    # Basic
2216
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2217
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2218
            title  => sub { uc $_[0] }
2219
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2220
        }
update pod
Yuki Kimoto authored on 2011-03-13
2221
    );
2222
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2223
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2224
    $dbi->insert(
2225
        filter => [
2226
            [qw/title author/]  => sub { uc $_[0] }
2227
        ]
2228
    );
2229
    
2230
    # Filter name
2231
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2232
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2233
            title  => 'upper_case',
2234
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2235
        }
update pod
Yuki Kimoto authored on 2011-03-13
2236
    );
2237

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

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

            
2242
Get L<DBIx::Custom::Query> object instead of executing SQL.
2243
This is true or false value.
2244

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2251
=back
2252

            
2253
=over 4
2254

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2270
    lib / MyModel.pm
2271
        / MyModel / book.pm
2272
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2273

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

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

            
2278
    package MyModel;
2279
    
2280
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2281
    
2282
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2283

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2288
    package MyModel::book;
2289
    
2290
    use base 'MyModel';
2291
    
2292
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2293

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2296
    package MyModel::company;
2297
    
2298
    use base 'MyModel';
2299
    
2300
    1;
2301
    
2302
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2303

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

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

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

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

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

            
2315
Merge paramters.
2316

            
2317
$param:
2318

            
2319
    {key1 => [1, 1], key2 => 2}
2320

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

            
2323
    $dbi->method(
2324
        update_or_insert => sub {
2325
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2326
            
2327
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2328
        },
2329
        find_or_create   => sub {
2330
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2331
            
2332
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2333
        }
2334
    );
2335

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

            
2338
    $dbi->update_or_insert;
2339
    $dbi->find_or_create;
2340

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

            
2343
    $dbi->model('book')->method(
2344
        insert => sub { ... },
2345
        update => sub { ... }
2346
    );
2347
    
2348
    my $model = $dbi->model('book');
2349

            
2350
Set and get a L<DBIx::Custom::Model> object,
2351

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

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

            
2356
Create column clause for myself. The follwoing column clause is created.
2357

            
2358
    book.author as author,
2359
    book.title as title
2360

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2363
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2364
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2365
        user => 'ken',
2366
        password => '!LFKD%$&',
2367
        dbi_option => {mysql_enable_utf8 => 1}
2368
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2369

            
2370
Create a new L<DBIx::Custom> object.
2371

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

            
2374
    my $not_exists = $dbi->not_exists;
2375

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2379
=head2 C<register_filter>
2380

            
update pod
Yuki Kimoto authored on 2011-03-13
2381
    $dbi->register_filter(
2382
        # Time::Piece object to database DATE format
2383
        tp_to_date => sub {
2384
            my $tp = shift;
2385
            return $tp->strftime('%Y-%m-%d');
2386
        },
2387
        # database DATE format to Time::Piece object
2388
        date_to_tp => sub {
2389
           my $date = shift;
2390
           return Time::Piece->strptime($date, '%Y-%m-%d');
2391
        }
2392
    );
cleanup
yuki-kimoto authored on 2010-10-17
2393
    
update pod
Yuki Kimoto authored on 2011-03-13
2394
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2395

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

            
2398
    $dbi->type_rule(
2399
        DATE => {
2400
            from => sub { ... },
2401
            into => sub { ... }
2402
        },
2403
        DATETIME => {
2404
            from => sub { ... }
2405
            into => sub { ... }
2406
        }
2407
    );
2408

            
2409
Filter based on type.
2410

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2413
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2414
        table  => 'book',
2415
        column => ['author', 'title'],
2416
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2417
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2418
    
update pod
Yuki Kimoto authored on 2011-03-12
2419
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2420

            
2421
The following opitons are currently available.
2422

            
2423
=over 4
2424

            
2425
=item C<table>
2426

            
2427
Table name.
2428

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

            
2431
=item C<column>
2432

            
2433
Column clause. This is array reference or constant value.
2434

            
updated pod
Yuki Kimoto authored on 2011-06-07
2435
    # Array reference
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2436
    $dbi->select(column => ['author', 'title']);
2437
    
2438
    # Constant value
2439
    $dbi->select(column => 'author');
updated pod
Yuki Kimoto authored on 2011-06-07
2440
    
2441
Default is '*' if C<column> is not specified.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2442

            
2443
    # Default
2444
    $dbi->select(column => '*');
2445

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

            
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
2448
    # Hash reference EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-07
2449
    $dbi->select(column => [
2450
        {book => [qw/author title/]},
2451
        {person => [qw/name age/]}
2452
    ]);
2453

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

            
2456
    book.author as "book.author",
2457
    book.title as "book.title",
2458
    person.name as "person.name",
2459
    person.age as "person.age"
2460

            
2461
You can specify array reference in array refernce.
2462

            
2463
    $dbi->select(column => [
2464
        ['date(book.register_datetime)', as => 'book.register_date']
2465
    ]);
2466

            
2467
These is joined and quoted.
2468

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

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2473
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2474
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2475
    
2476
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2477
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2478
    
update pod
Yuki Kimoto authored on 2011-03-12
2479
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2480
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2481
        clause => ['and', 'author = :author', 'title like :title'],
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2482
        param  => {author => 'Ken', title => '%Perl%'}
2483
    );
update pod
Yuki Kimoto authored on 2011-03-12
2484
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2485

            
updated pod
Yuki Kimoto authored on 2011-04-25
2486
    # String(with where_param option)
2487
    $dbi->select(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2488
        where => 'title like :title',
updated pod
Yuki Kimoto authored on 2011-04-25
2489
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2490
    );
2491
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2492
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2493

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

            
2496
    $dbi->select(join =>
2497
        [
2498
            'left outer join company on book.company_id = company_id',
2499
            'left outer join location on company.location_id = location.id'
2500
        ]
2501
    );
2502

            
2503
If column cluase or where clause contain table name like "company.name",
2504
needed join clause is used automatically.
2505

            
2506
    $dbi->select(
2507
        table => 'book',
2508
        column => ['company.location_id as company__location_id'],
2509
        where => {'company.name' => 'Orange'},
2510
        join => [
2511
            'left outer join company on book.company_id = company.id',
2512
            'left outer join location on company.location_id = location.id'
2513
        ]
2514
    );
2515

            
2516
In above select, the following SQL is created.
2517

            
2518
    select company.location_id as company__location_id
2519
    from book
2520
      left outer join company on book.company_id = company.id
2521
    where company.name = Orange
2522

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

            
2525
Parameter shown before where clause.
2526
    
2527
    $dbi->select(
2528
        table => 'table1',
2529
        column => 'table1.key1 as table1_key1, key2, key3',
2530
        where   => {'table1.key2' => 3},
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2531
        join  => ['inner join (select * from table2 where table2.key3 = :table2.key3)' . 
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2532
                  ' as table2 on table1.key1 = table2.key1'],
2533
        param => {'table2.key3' => 5}
2534
    );
2535

            
2536
For example, if you want to contain tag in join clause, 
2537
you can pass parameter by C<param> option.
2538

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

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

            
2543
    $dbi->select(append => 'order by title');
updated pod
Yuki Kimoto authored on 2011-06-08
2544
    
2545
=item C<id>
2546

            
2547
Select using primary_key.
2548

            
2549
    $dbi->select(
2550
        primary_key => 'id',
2551
        id => 4,
2552
    );
2553

            
2554
    $dbi->select(
2555
        primary_key => ['id1', 'id2'],
2556
        id => [4, 5]
2557
    );
2558

            
2559
The above is same as the followin ones.
2560

            
2561
    $dbi->insert(where => {id => 4});
2562

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

            
2565
=item C<primary_key>
2566

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

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

            
2571
Wrap statement. This is array reference.
2572

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

            
2575
This option is for Oracle and SQL Server paging process.
2576

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

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

            
2583
    # Basic
2584
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2585
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2586
            title  => sub { uc $_[0] }
2587
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2588
        }
update pod
Yuki Kimoto authored on 2011-03-12
2589
    );
2590
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2591
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2592
    $dbi->select(
2593
        filter => [
2594
            [qw/title author/]  => sub { uc $_[0] }
2595
        ]
2596
    );
2597
    
2598
    # Filter name
2599
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2600
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2601
            title  => 'upper_case',
2602
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2603
        }
update pod
Yuki Kimoto authored on 2011-03-12
2604
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2605

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

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

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

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

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

            
2617
    my $sql = $query->sql;
2618

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

            
2621
Specify database data type.
2622

            
2623
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2624
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2625

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

            
2628
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2629

            
update pod
Yuki Kimoto authored on 2011-03-12
2630
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2631

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2634
    $dbi->update(
2635
        table  => 'book',
2636
        param  => {title => 'Perl'},
2637
        where  => {id => 4}
2638
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2639

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2644
=over 4
2645

            
2646
=item C<param>
2647

            
2648
Update data. This is hash reference.
2649

            
2650
    $dbi->update(param => {title => 'Perl'});
2651

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

            
2654
    $dbi->update(
2655
        {title => 'Perl'},
2656
        table => 'book',
2657
        where => {author => 'Ken'}
2658
    );
2659

            
2660
=item C<table>
2661

            
2662
Table name.
2663

            
2664
    $dbi->update(table => 'book');
2665

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2668
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2669
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2670
    
2671
    # Hash reference
2672
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2673
    
2674
    # DBIx::Custom::Where object
2675
    my $where = $dbi->where(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2676
        clause => ['and', 'author = :author', 'title like :title'],
update pod
Yuki Kimoto authored on 2011-03-13
2677
        param  => {author => 'Ken', title => '%Perl%'}
2678
    );
2679
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2680
    
updated pod
Yuki Kimoto authored on 2011-04-25
2681
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2682
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2683
        param => {title => 'Perl'},
updated pod
Yuki Kimoto authored on 2011-06-08
2684
        where => 'id = :id',
updated pod
Yuki Kimoto authored on 2011-04-25
2685
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2686
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2687
    
update pod
Yuki Kimoto authored on 2011-03-13
2688
=item C<append>
2689

            
2690
Append statement to last of SQL. This is string.
2691

            
2692
    $dbi->update(append => 'order by title');
2693

            
2694
=item C<filter>
2695

            
2696
Filter, executed before data is send to database. This is array reference.
2697
Filter value is code reference or
2698
filter name registerd by C<register_filter()>.
2699

            
2700
    # Basic
2701
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2702
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2703
            title  => sub { uc $_[0] }
2704
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2705
        }
update pod
Yuki Kimoto authored on 2011-03-13
2706
    );
2707
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2708
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2709
    $dbi->update(
2710
        filter => [
2711
            [qw/title author/]  => sub { uc $_[0] }
2712
        ]
2713
    );
2714
    
2715
    # Filter name
2716
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2717
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2718
            title  => 'upper_case',
2719
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2720
        }
update pod
Yuki Kimoto authored on 2011-03-13
2721
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2722

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

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

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

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

            
2732
You can check SQL.
2733

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2738
    $dbi->insert(
2739
        primary_key => 'id',
2740
        id => 4,
2741
        param => {title => 'Perl', author => 'Ken'}
2742
    );
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2743

            
updated pod
Yuki Kimoto authored on 2011-06-08
2744
    $dbi->insert(
2745
        primary_key => ['id1', 'id2'],
2746
        id => [4, 5],
2747
        param => {title => 'Perl', author => 'Ken'}
2748
    );
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2749

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

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2764
    $dbi->update(
2765
        primary_key => 'id',
2766
        id => 4,
2767
        param => {title => 'Perl', author => 'Ken'}
2768
    );
update pod
Yuki Kimoto authored on 2011-03-13
2769

            
updated pod
Yuki Kimoto authored on 2011-06-08
2770
    $dbi->update(
2771
        primary_key => ['id1', 'id2'],
2772
        id => [4, 5],
2773
        param => {title => 'Perl', author => 'Ken'}
2774
    );
update pod
Yuki Kimoto authored on 2011-03-13
2775

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2778
    $dbi->update(
2779
        where => {id => 4}
2780
        param => {title => 'Perl', author => 'Ken'}
2781
    );
update pod
Yuki Kimoto authored on 2011-03-13
2782

            
updated pod
Yuki Kimoto authored on 2011-06-08
2783
    $dbi->update(
2784
        where => {id1 => 4, id2 => 5},
2785
        param => {title => 'Perl', author => 'Ken'}
2786
    );
update pod
Yuki Kimoto authored on 2011-03-13
2787

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-08
2792
=back
update pod
Yuki Kimoto authored on 2011-03-13
2793

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

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

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

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

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

            
2805
Create update parameter tag.
2806

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

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

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

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

            
2818
Create a new L<DBIx::Custom::Where> object.
2819

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

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

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

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

            
2829
Update statement, using primary key.
2830

            
2831
    $dbi->update_at(
2832
        table => 'book',
2833
        primary_key => 'id',
2834
        where => '5',
2835
        param => {title => 'Perl'}
2836
    );
2837

            
2838
This method is same as C<update()> exept that
2839
C<primary_key> is specified and C<where> is constant value or array refrence.
2840
all option of C<update()> is available.
2841

            
2842
=head2 C<delete_at()> DEPRECATED!
2843

            
2844
Delete statement, using primary key.
2845

            
2846
    $dbi->delete_at(
2847
        table => 'book',
2848
        primary_key => 'id',
2849
        where => '5'
2850
    );
2851

            
2852
This method is same as C<delete()> exept that
2853
C<primary_key> is specified and C<where> is constant value or array refrence.
2854
all option of C<delete()> is available.
2855

            
2856
=head2 C<select_at()> DEPRECATED!
2857

            
2858
Select statement, using primary key.
2859

            
2860
    $dbi->select_at(
2861
        table => 'book',
2862
        primary_key => 'id',
2863
        where => '5'
2864
    );
2865

            
2866
This method is same as C<select()> exept that
2867
C<primary_key> is specified and C<where> is constant value or array refrence.
2868
all option of C<select()> is available.
2869

            
2870
=head2 C<register_tag> DEPRECATED!
2871

            
2872
    $dbi->register_tag(
2873
        update => sub {
2874
            my @columns = @_;
2875
            
2876
            # Update parameters
2877
            my $s = 'set ';
2878
            $s .= "$_ = ?, " for @columns;
2879
            $s =~ s/, $//;
2880
            
2881
            return [$s, \@columns];
2882
        }
2883
    );
2884

            
2885
Register tag, used by C<execute()>.
2886

            
2887
See also L<Tags/Tags> about tag registered by default.
2888

            
2889
Tag parser receive arguments specified in tag.
2890
In the following tag, 'title' and 'author' is parser arguments
2891

            
2892
    {update_param title author} 
2893

            
2894
Tag parser must return array refrence,
2895
first element is the result statement, 
2896
second element is column names corresponding to place holders.
2897

            
2898
In this example, result statement is 
2899

            
2900
    set title = ?, author = ?
2901

            
2902
Column names is
2903

            
2904
    ['title', 'author']
2905

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2906
=head1 Parameter
2907

            
2908
Parameter start at ':'. This is replaced to place holoder
2909

            
2910
    $dbi->execute(
2911
        "select * from book where title = :title and author = :author"
2912
        param => {title => 'Perl', author => 'Ken'}
2913
    );
2914

            
2915
    "select * from book where title = ? and author = ?"
2916

            
2917
=head1 Tags DEPRECATED!
2918

            
2919
B<Tag> system is DEPRECATED! use parameter system :name instead.
2920
Parameter is simple and readable.
2921

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

            
2924
The following tags is available.
2925

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

            
2928
Placeholder tag.
2929

            
2930
    {? NAME}    ->   ?
2931

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

            
2934
Equal tag.
2935

            
2936
    {= NAME}    ->   NAME = ?
2937

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

            
2940
Not equal tag.
2941

            
2942
    {<> NAME}   ->   NAME <> ?
2943

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

            
2946
Lower than tag
2947

            
2948
    {< NAME}    ->   NAME < ?
2949

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

            
2952
Greater than tag
2953

            
2954
    {> NAME}    ->   NAME > ?
2955

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

            
2958
Greater than or equal tag
2959

            
2960
    {>= NAME}   ->   NAME >= ?
2961

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

            
2964
Lower than or equal tag
2965

            
2966
    {<= NAME}   ->   NAME <= ?
2967

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

            
2970
Like tag
2971

            
2972
    {like NAME}   ->   NAME like ?
2973

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

            
2976
In tag.
2977

            
2978
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2979

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

            
2982
Insert parameter tag.
2983

            
2984
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2985

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

            
2988
Updata parameter tag.
2989

            
2990
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2991

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

            
2994
Insert statement, using primary key.
2995

            
2996
    $dbi->insert_at(
2997
        table => 'book',
2998
        primary_key => 'id',
2999
        where => '5',
3000
        param => {title => 'Perl'}
3001
    );
3002

            
3003
This method is same as C<insert()> exept that
3004
C<primary_key> is specified and C<where> is constant value or array refrence.
3005
all option of C<insert()> is available.
3006

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

            
3009
=head2 C<DBIX_CUSTOM_DEBUG>
3010

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

            
3014
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3015

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

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

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

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

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

            
3027
C<< <kimoto.yuki at gmail.com> >>
3028

            
3029
L<http://github.com/yuki-kimoto/DBIx-Custom>
3030

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
3031
=head1 AUTHOR
3032

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

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

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

            
3039
This program is free software; you can redistribute it and/or modify it
3040
under the same terms as Perl itself.
3041

            
3042
=cut