DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
3543 lines | 91.931kb
cleanup
yuki-kimoto authored on 2009-12-22
1
package DBIx::Custom;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
2
use Object::Simple -base;
cleanup
yuki-kimoto authored on 2009-12-22
3

            
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
4
our $VERSION = '0.1738';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
5
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
6

            
packaging one directory
yuki-kimoto authored on 2009-11-16
7
use Carp 'croak';
8
use DBI;
9
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
10
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
11
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
12
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
13
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
14
use DBIx::Custom::Tag;
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
15
use DBIx::Custom::Order;
cleanup
Yuki Kimoto authored on 2011-04-25
16
use DBIx::Custom::Util qw/_array_to_hash _subname/;
added tests
Yuki Kimoto authored on 2011-08-26
17
use DBIx::Custom::Mapper;
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
18
use DBIx::Custom::NotExists;
improved debug message
Yuki Kimoto authored on 2011-05-23
19
use Encode qw/encode encode_utf8 decode_utf8/;
cleanup
Yuki Kimoto authored on 2011-08-13
20
use Scalar::Util qw/weaken/;
packaging one directory
yuki-kimoto authored on 2009-11-16
21

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
22
has [qw/connector dsn password quote user exclude_table user_table_info
23
        user_column_info/],
removed from cache() and cac...
Yuki Kimoto authored on 2011-03-29
24
    cache => 0,
many changed
Yuki Kimoto authored on 2011-01-23
25
    cache_method => sub {
26
        sub {
27
            my $self = shift;
28
            
29
            $self->{_cached} ||= {};
30
            
31
            if (@_ > 1) {
update pod
Yuki Kimoto authored on 2011-03-13
32
                $self->{_cached}{$_[0]} = $_[1];
many changed
Yuki Kimoto authored on 2011-01-23
33
            }
34
            else {
update pod
Yuki Kimoto authored on 2011-03-13
35
                return $self->{_cached}{$_[0]};
many changed
Yuki Kimoto authored on 2011-01-23
36
            }
37
        }
update pod
Yuki Kimoto authored on 2011-03-13
38
    },
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
39
    option => sub { {} },
40
    default_option => sub {
update pod
Yuki Kimoto authored on 2011-03-13
41
        {
42
            RaiseError => 1,
43
            PrintError => 0,
44
            AutoCommit => 1
45
        }
46
    },
fix tests
Yuki Kimoto authored on 2011-01-13
47
    filters => sub {
48
        {
49
            encode_utf8 => sub { encode_utf8($_[0]) },
50
            decode_utf8 => sub { decode_utf8($_[0]) }
51
        }
update pod
Yuki Kimoto authored on 2011-03-13
52
    },
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
53
    last_sql => '',
update pod
Yuki Kimoto authored on 2011-03-13
54
    models => sub { {} },
cleanup
Yuki Kimoto authored on 2011-08-13
55
    query_builder => sub {
56
        my $self = shift;
57
        my $builder = DBIx::Custom::QueryBuilder->new(dbi => $self);
58
        weaken $builder->{dbi};
59
        return $builder;
60
    },
update pod
Yuki Kimoto authored on 2011-03-13
61
    result_class  => 'DBIx::Custom::Result',
62
    safety_character => '\w',
cleanup test
Yuki Kimoto authored on 2011-08-10
63
    separator => '.',
added tag_parse attribute
Yuki Kimoto authored on 2011-06-28
64
    stash => sub { {} },
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
65
    tag_parse => 1;
cleanup
yuki-kimoto authored on 2010-10-17
66

            
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
67
sub available_datatype {
test cleanup
Yuki Kimoto authored on 2011-08-10
68
    my $self = shift;
69
    
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
70
    my $data_types = '';
cleanup
Yuki Kimoto authored on 2011-10-21
71
    for my $i (-1000 .. 1000) {
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
72
         my $type_info = $self->dbh->type_info($i);
73
         my $data_type = $type_info->{DATA_TYPE};
74
         my $type_name = $type_info->{TYPE_NAME};
75
         $data_types .= "$data_type ($type_name)\n"
76
           if defined $data_type;
77
    }
78
    return "Data Type maybe equal to Type Name" unless $data_types;
79
    $data_types = "Data Type (Type name)\n" . $data_types;
80
    return $data_types;
81
}
82

            
83
sub available_typename {
84
    my $self = shift;
85
    
86
    # Type Names
87
    my $type_names = {};
88
    $self->each_column(sub {
89
        my ($self, $table, $column, $column_info) = @_;
90
        $type_names->{$column_info->{TYPE_NAME}} = 1
91
          if $column_info->{TYPE_NAME};
92
    });
93
    my @output = sort keys %$type_names;
94
    unshift @output, "Type Name";
95
    return join "\n", @output;
test cleanup
Yuki Kimoto authored on 2011-08-10
96
}
97

            
added helper method
yuki-kimoto authored on 2010-10-17
98
our $AUTOLOAD;
99
sub AUTOLOAD {
100
    my $self = shift;
101

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
105
    # Call method
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
106
    $self->{_methods} ||= {};
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
107
    if (my $method = $self->{_methods}->{$mname}) {
108
        return $self->$method(@_)
109
    }
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
110
    elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
111
        $self->dbh->$dbh_method(@_);
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
112
    }
113
    else {
cleanup
Yuki Kimoto authored on 2011-04-25
114
        croak qq{Can't locate object method "$mname" via "$package" }
115
            . _subname;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
116
    }
added helper method
yuki-kimoto authored on 2010-10-17
117
}
118

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
119
sub assign_clause {
updated pod
Yuki Kimoto authored on 2011-09-02
120
    my ($self, $param, $opts) = @_;
121
    
122
    my $wrap = $opts->{wrap} || {};
micro optimization
Yuki Kimoto authored on 2011-10-23
123
    my $safety = $self->{safety_character} || $self->safety_character;
fixed some quoted bug
Yuki Kimoto authored on 2011-10-22
124
    my $qp = $self->_q('');
125
    my $q = substr($qp, 0, 1) || '';
126
    my $p = substr($qp, 1, 1) || '';
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
127
    
micro optimization
Yuki Kimoto authored on 2011-10-23
128
    # Check unsafety keys
129
    unless ((join('', keys %$param) || '') =~ /^[$safety\.]+$/) {
130
        for my $column (keys %$param) {
131
            croak qq{"$column" is not safety column name } . _subname
132
              unless $column =~ /^[$safety\.]+$/;
133
        }
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
134
    }
135
    
micro optimization
Yuki Kimoto authored on 2011-10-23
136
    # Assign clause (performance is important)
micro optimization
Yuki Kimoto authored on 2011-10-23
137
    join(
138
      ', ',
139
      map {
140
          ref $param->{$_} eq 'SCALAR' ? "$q$_$p = " . ${$param->{$_}}
141
          : $wrap->{$_} ? "$q$_$p = " . $wrap->{$_}->(":$_")
142
          : "$q$_$p = :$_";
143
      } sort keys %$param
144
    );
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
145
}
146

            
cleanup
Yuki Kimoto authored on 2011-03-21
147
sub column {
- DBIx::Custom Model filter ...
Yuki Kimoto authored on 2011-06-15
148
    my $self = shift;
149
    my $option = pop if ref $_[-1] eq 'HASH';
150
    my $real_table = shift;
151
    my $columns = shift;
152
    my $table = $option->{alias} || $real_table;
153
    
154
    # Columns
155
    unless ($columns) {
156
        $columns ||= $self->model($real_table)->columns;
157
    }
added helper method
yuki-kimoto authored on 2010-10-17
158
    
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
159
    # Separator
160
    my $separator = $self->separator;
161
    
cleanup
Yuki Kimoto authored on 2011-04-02
162
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
163
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
164
    $columns ||= [];
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
165
    push @column, $self->_q($table) . "." . $self->_q($_) .
166
      " as " . $self->_q("${table}${separator}$_")
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
167
      for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
168
    
169
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
170
}
171

            
packaging one directory
yuki-kimoto authored on 2009-11-16
172
sub connect {
cleanup
Yuki Kimoto authored on 2011-08-16
173
    my $self = ref $_[0] ? shift : shift->new(@_);
174
    
175
    my $connector = $self->connector;
176
    
177
    if (!ref $connector && $connector) {
178
        require DBIx::Connector;
179
        
180
        my $dsn = $self->dsn;
181
        my $user = $self->user;
182
        my $password = $self->password;
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
183
        my $option = $self->_option;
cleanup
Yuki Kimoto authored on 2011-08-16
184
        my $connector = DBIx::Connector->new($dsn, $user, $password,
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
185
          {%{$self->default_option} , %$option});
cleanup
Yuki Kimoto authored on 2011-08-16
186
        $self->connector($connector);
187
    }
removed register_format()
yuki-kimoto authored on 2010-05-26
188
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
189
    # Connect
190
    $self->dbh;
update document
yuki-kimoto authored on 2010-01-30
191
    
packaging one directory
yuki-kimoto authored on 2009-11-16
192
    return $self;
193
}
194

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
195
sub count { shift->select(column => 'count(*)', @_)->fetch_first->[0] }
196

            
update pod
Yuki Kimoto authored on 2011-03-13
197
sub dbh {
198
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
199
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
200
    # Set
201
    if (@_) {
202
        $self->{dbh} = $_[0];
203
        
204
        return $self;
205
    }
206
    
207
    # Get
208
    else {
209
        # From Connction manager
210
        if (my $connector = $self->connector) {
cleanup
Yuki Kimoto authored on 2011-04-25
211
            croak "connector must have dbh() method " . _subname
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
212
              unless ref $connector && $connector->can('dbh');
213
              
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
214
            $self->{dbh} = $connector->dbh;
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
215
        }
216
        
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
217
        # Connect
218
        $self->{dbh} ||= $self->_connect;
219
        
220
        # Quote
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
221
        if (!defined $self->reserved_word_quote && !defined $self->quote) {
prepare oracle test
Yuki Kimoto authored on 2011-08-15
222
            my $driver = $self->_driver;
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
223
            my $quote =  $driver eq 'odbc' ? '[]'
224
                       : $driver eq 'ado' ? '[]'
225
                       : $driver eq 'mysql' ? '`'
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
226
                       : '"';
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
227
            $self->quote($quote);
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
228
        }
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
229
        
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
230
        return $self->{dbh};
update pod
Yuki Kimoto authored on 2011-03-13
231
    }
232
}
233

            
cleanup
Yuki Kimoto authored on 2011-10-21
234
sub delete {
235
    my ($self, %opt) = @_;
236
    warn "delete method where_param option is DEPRECATED!"
237
      if $opt{where_param};
238
    
cleanup
Yuki Kimoto authored on 2011-10-21
239
    # Don't allow delete all rows
cleanup
Yuki Kimoto authored on 2011-10-21
240
    croak qq{delete method where or id option must be specified } . _subname
241
      if !$opt{where} && !defined $opt{id} && !$opt{allow_delete_all};
242
    
243
    # Where
cleanup
Yuki Kimoto authored on 2011-10-25
244
    my $w = $self->_where_clause_and_param($opt{where}, $opt{where_param},
cleanup
Yuki Kimoto authored on 2011-10-25
245
      delete $opt{id}, $opt{primary_key}, $opt{table});
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
246

            
cleanup
Yuki Kimoto authored on 2011-04-02
247
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-10-21
248
    my $sql = "delete ";
cleanup
Yuki Kimoto authored on 2011-10-21
249
    $sql .= "$opt{prefix} " if defined $opt{prefix};
cleanup
Yuki Kimoto authored on 2011-10-25
250
    $sql .= "from " . $self->_q($opt{table}) . " $w->{clause} ";
packaging one directory
yuki-kimoto authored on 2009-11-16
251
    
252
    # Execute query
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
253
    $opt{statement} = 'delete';
cleanup
Yuki Kimoto authored on 2011-10-25
254
    $self->execute($sql, $w->{param}, %opt);
packaging one directory
yuki-kimoto authored on 2009-11-16
255
}
256

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

            
added memory leak check test
Yuki Kimoto authored on 2011-08-15
259
sub DESTROY {}
added helper method
yuki-kimoto authored on 2010-10-17
260

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
261
sub create_model {
262
    my $self = shift;
263
    
cleanup
Yuki Kimoto authored on 2011-10-21
264
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
265
    my $opt = ref $_[0] eq 'HASH' ? $_[0] : {@_};
266
    $opt->{dbi} = $self;
267
    my $model_class = delete $opt->{model_class} || 'DBIx::Custom::Model';
268
    my $model_name  = delete $opt->{name};
269
    my $model_table = delete $opt->{table};
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
270
    $model_name ||= $model_table;
271
    
cleanup
Yuki Kimoto authored on 2011-04-02
272
    # Create model
cleanup
Yuki Kimoto authored on 2011-10-21
273
    my $model = $model_class->new($opt);
cleanup
Yuki Kimoto authored on 2011-08-13
274
    weaken $model->{dbi};
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
275
    $model->name($model_name) unless $model->name;
276
    $model->table($model_table) unless $model->table;
277
    
micro optimization
Yuki Kimoto authored on 2011-07-30
278
    # Apply filter(DEPRECATED logic)
279
    if ($model->{filter}) {
280
        my $filter = ref $model->filter eq 'HASH'
281
                   ? [%{$model->filter}]
282
                   : $model->filter;
283
        $filter ||= [];
284
        warn "DBIx::Custom::Model filter method is DEPRECATED!"
285
          if @$filter;
286
        $self->_apply_filter($model->table, @$filter);
287
    }
288
    
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
289
    # Set model
290
    $self->model($model->name, $model);
291
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
292
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
293
}
294

            
295
sub each_column {
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
296
    my ($self, $cb, %options) = @_;
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
297

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
298
    my $user_column_info = $self->user_column_info;
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
299
    
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
300
    if ($user_column_info) {
301
        $self->$cb($_->{table}, $_->{column}, $_->{info}) for @$user_column_info;
302
    }
303
    else {
304
    
305
        my $re = $self->exclude_table || $options{exclude_table};
306
        # Tables
307
        my %tables;
308
        $self->each_table(sub { $tables{$_[1]}++ });
added SQL Server test
Yuki Kimoto authored on 2011-08-14
309

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
310
        # Iterate all tables
311
        my @tables = sort keys %tables;
312
        for (my $i = 0; $i < @tables; $i++) {
313
            my $table = $tables[$i];
314
            
315
            # Iterate all columns
316
            my $sth_columns;
317
            eval {$sth_columns = $self->dbh->column_info(undef, undef, $table, '%')};
318
            next if $@;
319
            while (my $column_info = $sth_columns->fetchrow_hashref) {
320
                my $column = $column_info->{COLUMN_NAME};
321
                $self->$cb($table, $column, $column_info);
322
            }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
323
        }
324
    }
325
}
326

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
327
sub each_table {
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
328
    my ($self, $cb, %option) = @_;
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
329
    
cleanup test
Yuki Kimoto authored on 2011-08-16
330
    my $user_table_infos = $self->user_table_info;
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
331
    
added test
Yuki Kimoto authored on 2011-08-16
332
    # Iterate tables
333
    if ($user_table_infos) {
334
        $self->$cb($_->{table}, $_->{info}) for @$user_table_infos;
335
    }
336
    else {
337
        my $re = $self->exclude_table || $option{exclude};
338
        my $sth_tables = $self->dbh->table_info;
339
        while (my $table_info = $sth_tables->fetchrow_hashref) {
340
            
341
            # Table
342
            my $table = $table_info->{TABLE_NAME};
343
            next if defined $re && $table =~ /$re/;
344
            $self->$cb($table, $table_info);
345
        }
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
346
    }
347
}
348

            
cleanup
Yuki Kimoto authored on 2011-04-02
349
sub execute {
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
350
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-10-20
351
    my $sql = shift;
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
352

            
353
    # Options
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
354
    my $param;
355
    $param = shift if @_ % 2;
cleanup
Yuki Kimoto authored on 2011-10-21
356
    my %opt = @_;
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
357
    warn "sqlfilter option is DEPRECATED" if $opt{sqlfilter};
358
    $param ||= $opt{param} || {};
cleanup
Yuki Kimoto authored on 2011-10-21
359
    my $tables = $opt{table} || [];
cleanup
Yuki Kimoto authored on 2011-04-02
360
    $tables = [$tables] unless ref $tables eq 'ARRAY';
micro optimization
Yuki Kimoto authored on 2011-10-23
361
    my $filter = ref $opt{filter} eq 'ARRAY' ?
362
      _array_to_hash($opt{filter}) : $opt{filter};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
363
    
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
364
    # Append
365
    $sql .= $opt{append} if defined $opt{append} && !ref $sql;
366
    
367
    # Query
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
368
    my $query;
369
    if (ref $sql) { $query = $sql }
370
    else {
371
        $query = $opt{reuse}->{$sql} if $opt{reuse};
372
        $query = $self->_create_query($sql,$opt{after_build_sql} || $opt{sqlfilter})
373
          unless $query;
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
374
        $query->statement($opt{statement} || '');
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
375
        $opt{reuse}->{$sql} = $query if $opt{reuse};
376
    }
377
        
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
378
    # Save query
micro optimization
Yuki Kimoto authored on 2011-10-23
379
    $self->{last_sql} = $query->{sql};
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
380

            
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
381
    # Return query
382
    return $query if $opt{query};
micro optimization
Yuki Kimoto authored on 2011-07-30
383
    
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
384
    # Merge query filter(DEPRECATED!)
DBIx::Custom::Query filter m...
Yuki Kimoto authored on 2011-07-30
385
    $filter ||= $query->{filter} || {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
386
    
cleanup
Yuki Kimoto authored on 2011-04-02
387
    # Tables
DBIx::Custom::Query tables a...
Yuki Kimoto authored on 2011-07-30
388
    unshift @$tables, @{$query->{tables} || []};
micro optimization
Yuki Kimoto authored on 2011-07-30
389
    my $main_table = @{$tables}[-1];
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
390

            
391
    # Merge id to parameter
392
    my @cleanup;
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
393
    if (defined $opt{id}) {
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
394
        croak "execute id option must be specified with primary_key option"
395
          unless $opt{primary_key};
396
        $opt{primary_key} = [$opt{primary_key}] unless ref $opt{primary_key};
397
        $opt{id} = [$opt{id}] unless ref $opt{id};
398
        my $statement = $query->statement;
399
        for (my $i = 0; $i < @{$opt{primary_key}}; $i++) {
400
           my $key = $opt{primary_key}->[$i];
401
           $key = "$main_table.$key" if $statement eq 'update' ||
402
             $statement eq 'delete' || $statement eq 'select';
403
           next if exists $param->{$key};
404
           $param->{$key} = $opt{id}->[$i];
405
           push @cleanup, $key;
406
        }
fixed id option bug when col...
Yuki Kimoto authored on 2011-10-10
407
    }
micro optimization
Yuki Kimoto authored on 2011-07-30
408
    
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
409
    # Cleanup tables(DEPRECATED!)
micro optimization
Yuki Kimoto authored on 2011-07-30
410
    $tables = $self->_remove_duplicate_table($tables, $main_table)
411
      if @$tables > 1;
cleanup
Yuki Kimoto authored on 2011-04-02
412
    
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
413
    # Type rule
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
414
    my $type_filters = {};
micro optimization
Yuki Kimoto authored on 2011-10-23
415
    if ($self->{_type_rule_is_called}) {
416
        unless ($opt{type_rule_off}) {
417
            my $type_rule_off_parts = {
418
                1 => $opt{type_rule1_off},
419
                2 => $opt{type_rule2_off}
420
            };
421
            for my $i (1, 2) {
422
                unless ($type_rule_off_parts->{$i}) {
423
                    $type_filters->{$i} = {};
424
                    my $table_alias = $opt{table_alias} || {};
425
                    for my $alias (keys %$table_alias) {
426
                        my $table = $table_alias->{$alias};
427
                        
428
                        for my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
429
                            $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
430
                        }
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
431
                    }
micro optimization
Yuki Kimoto authored on 2011-10-23
432
                    $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
433
                      if $main_table;
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
434
                }
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
435
            }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
436
        }
437
    }
cleanup
Yuki Kimoto authored on 2011-04-02
438
    
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
439
    # Applied filter(DEPRECATED!)
micro optimization
Yuki Kimoto authored on 2011-07-30
440
    if ($self->{filter}{on}) {
441
        my $applied_filter = {};
cleanup
Yuki Kimoto authored on 2011-10-21
442
        for my $table (@$tables) {
micro optimization
Yuki Kimoto authored on 2011-07-30
443
            $applied_filter = {
444
                %$applied_filter,
445
                %{$self->{filter}{out}->{$table} || {}}
446
            }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
447
        }
micro optimization
Yuki Kimoto authored on 2011-07-30
448
        $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
449
    }
450
    
cleanup
Yuki Kimoto authored on 2011-04-02
451
    # Replace filter name to code
cleanup
Yuki Kimoto authored on 2011-10-21
452
    for my $column (keys %$filter) {
cleanup
Yuki Kimoto authored on 2011-04-02
453
        my $name = $filter->{$column};
454
        if (!defined $name) {
455
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
456
        }
cleanup
Yuki Kimoto authored on 2011-04-02
457
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
458
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
459
            unless exists $self->filters->{$name};
460
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
461
        }
462
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
463
    
cleanup
Yuki Kimoto authored on 2011-04-02
464
    # Create bind values
micro optimization
Yuki Kimoto authored on 2011-10-23
465
    my ($bind, $bind_types) = $self->_create_bind_values($param, $query->columns,
466
      $filter, $type_filters, $opt{bind_type} || $opt{type} || {});
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
467

            
cleanup
yuki-kimoto authored on 2010-10-17
468
    # Execute
micro optimization
Yuki Kimoto authored on 2011-10-23
469
    my $sth = $query->{sth};
cleanup
yuki-kimoto authored on 2010-10-17
470
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
471
    eval {
micro optimization
Yuki Kimoto authored on 2011-10-23
472
        if ($opt{bind_type} || $opt{type}) {
473
            $sth->bind_param($_ + 1, $bind->[$_],
474
                $bind_types->[$_] ? $bind_types->[$_] : ())
475
              for (0 .. @$bind - 1);
476
            $affected = $sth->execute;
477
        }
478
        else {
479
            $affected = $sth->execute(@$bind);
480
        }
cleanup
Yuki Kimoto authored on 2011-03-21
481
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
482
    
micro optimization
Yuki Kimoto authored on 2011-07-30
483
    $self->_croak($@, qq{. Following SQL is executed.\n}
484
      . qq{$query->{sql}\n} . _subname) if $@;
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
485

            
486
    # Remove id from parameter
487
    delete $param->{$_} for @cleanup;
cleanup
yuki-kimoto authored on 2010-10-17
488
    
improved debug message
Yuki Kimoto authored on 2011-05-23
489
    # DEBUG message
fixed DEBUG messsage bug
Yuki Kimoto authored on 2011-10-24
490
    if ($ENV{DBIX_CUSTOM_DEBUG}) {
491
        warn "SQL:\n" . $query->sql . "\n";
improved debug message
Yuki Kimoto authored on 2011-05-23
492
        my @output;
fixed DEBUG messsage bug
Yuki Kimoto authored on 2011-10-24
493
        for my $value (@$bind) {
improved debug message
Yuki Kimoto authored on 2011-05-23
494
            $value = 'undef' unless defined $value;
fixed DEBUG messsage bug
Yuki Kimoto authored on 2011-10-24
495
            $value = encode($ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8', $value)
improved debug message
Yuki Kimoto authored on 2011-05-23
496
              if utf8::is_utf8($value);
497
            push @output, $value;
498
        }
fixed DEBUG messsage bug
Yuki Kimoto authored on 2011-10-24
499
        warn "Bind values: " . join(', ', @output) . "\n\n";
improved debug message
Yuki Kimoto authored on 2011-05-23
500
    }
added environment variable D...
Yuki Kimoto authored on 2011-04-02
501
    
micro optimization
Yuki Kimoto authored on 2011-10-23
502
    # Not select statement
503
    return $affected unless $sth->{NUM_OF_FIELDS};
504

            
505
    # Filter(DEPRECATED!)
506
    my $infilter = {};
507
    if ($self->{filter}{on}) {
508
        $infilter->{in}  = {};
509
        $infilter->{end} = {};
510
        push @$tables, $main_table if $main_table;
511
        for my $table (@$tables) {
512
            for my $way (qw/in end/) {
513
                $infilter->{$way} = {%{$infilter->{$way}},
514
                  %{$self->{filter}{$way}{$table} || {}}};
cleanup
Yuki Kimoto authored on 2011-04-02
515
            }
cleanup
Yuki Kimoto authored on 2011-01-12
516
        }
cleanup
yuki-kimoto authored on 2010-10-17
517
    }
micro optimization
Yuki Kimoto authored on 2011-10-23
518
    
519
    # Result
520
    my $result = $self->result_class->new(
521
        sth => $sth,
522
        dbi => $self,
523
        default_filter => $self->{default_in_filter},
524
        filter => $infilter->{in} || {},
525
        end_filter => $infilter->{end} || {},
526
        type_rule => {
527
            from1 => $self->type_rule->{from1},
528
            from2 => $self->type_rule->{from2}
529
        },
530
    );
531
    $result;
cleanup
yuki-kimoto authored on 2010-10-17
532
}
533

            
added test
Yuki Kimoto authored on 2011-08-16
534
sub get_table_info {
cleanup
Yuki Kimoto authored on 2011-10-21
535
    my ($self, %opt) = @_;
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
536
    
cleanup
Yuki Kimoto authored on 2011-10-21
537
    my $exclude = delete $opt{exclude};
538
    croak qq/"$_" is wrong option/ for keys %opt;
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
539
    
added test
Yuki Kimoto authored on 2011-08-16
540
    my $table_info = [];
541
    $self->each_table(
542
        sub { push @$table_info, {table => $_[1], info => $_[2] } },
543
        exclude => $exclude
544
    );
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
545
    
cleanup test
Yuki Kimoto authored on 2011-08-16
546
    return [sort {$a->{table} cmp $b->{table} } @$table_info];
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
547
}
548

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
549
sub get_column_info {
cleanup
Yuki Kimoto authored on 2011-10-21
550
    my ($self, %opt) = @_;
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
551
    
cleanup
Yuki Kimoto authored on 2011-10-21
552
    my $exclude_table = delete $opt{exclude_table};
553
    croak qq/"$_" is wrong option/ for keys %opt;
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
554
    
555
    my $column_info = [];
556
    $self->each_column(
557
        sub { push @$column_info, {table => $_[1], column => $_[2], info => $_[3] } },
558
        exclude_table => $exclude_table
559
    );
560
    
561
    return [
562
      sort {$a->{table} cmp $b->{table} || $a->{column} cmp $b->{column} }
cleanup
Yuki Kimoto authored on 2011-08-16
563
        @$column_info];
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
564
}
565

            
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
566
sub helper {
567
    my $self = shift;
568
    
569
    # Register method
570
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
571
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
572
    
573
    return $self;
574
}
575

            
cleanup
yuki-kimoto authored on 2010-10-17
576
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
577
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
578
    
cleanup
Yuki Kimoto authored on 2011-10-21
579
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
580
    my $param = @_ % 2 ? shift : undef;
cleanup
Yuki Kimoto authored on 2011-10-21
581
    my %opt = @_;
micro optimization
Yuki Kimoto authored on 2011-10-23
582
    warn "insert method param option is DEPRECATED!" if $opt{param};
cleanup
Yuki Kimoto authored on 2011-10-21
583
    $param ||= delete $opt{param} || {};
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
584
    
585
    # Timestamp
cleanup
Yuki Kimoto authored on 2011-10-21
586
    if ($opt{timestamp} && (my $insert_timestamp = $self->insert_timestamp)) {
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
587
        my $columns = $insert_timestamp->[0];
588
        $columns = [$columns] unless ref $columns eq 'ARRAY';
589
        my $value = $insert_timestamp->[1];
590
        $value = $value->() if ref $value eq 'CODE';
591
        $param->{$_} = $value for @$columns;
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
592
    }
cleanup
Yuki Kimoto authored on 2011-10-21
593
    
594
    # Merge id to parameter
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
595
    my @cleanup;
micro optimization
Yuki Kimoto authored on 2011-10-23
596
    if (defined $opt{id}) {
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
597
        croak "insert id option must be specified with primary_key option"
micro optimization
Yuki Kimoto authored on 2011-10-23
598
          unless $opt{primary_key};
599
        $opt{primary_key} = [$opt{primary_key}] unless ref $opt{primary_key};
600
        $opt{id} = [$opt{id}] unless ref $opt{id};
601
        for (my $i = 0; $i < @{$opt{primary_key}}; $i++) {
602
           my $key = $opt{primary_key}->[$i];
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
603
           next if exists $param->{$key};
micro optimization
Yuki Kimoto authored on 2011-10-23
604
           $param->{$key} = $opt{id}->[$i];
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
605
           push @cleanup, $key;
micro optimization
Yuki Kimoto authored on 2011-10-23
606
        }
607
    }
cleanup
Yuki Kimoto authored on 2011-10-21
608
    
cleanup
Yuki Kimoto authored on 2011-04-02
609
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-10-21
610
    my $sql = "insert ";
cleanup
Yuki Kimoto authored on 2011-10-21
611
    $sql .= "$opt{prefix} " if defined $opt{prefix};
612
    $sql .= "into " . $self->_q($opt{table}) . " "
613
      . $self->values_clause($param, {wrap => $opt{wrap}}) . " ";
micro optimization
Yuki Kimoto authored on 2011-10-23
614

            
615
    # Remove id from parameter
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
616
    delete $param->{$_} for @cleanup;
packaging one directory
yuki-kimoto authored on 2009-11-16
617
    
618
    # Execute query
micro optimization
Yuki Kimoto authored on 2011-10-23
619
    $opt{statement} = 'insert';
micro optimization
Yuki Kimoto authored on 2011-10-23
620
    $self->execute($sql, $param, %opt);
packaging one directory
yuki-kimoto authored on 2009-11-16
621
}
622

            
micro optimization
Yuki Kimoto authored on 2011-10-23
623
sub _merge_id_to_param {
624
    my ($self, $id, $primary_keys, $param) = @_;
625
    
626
    # Create parameter
627
    $id = [$id] unless ref $id;
628
    
629
    return $param;
630
}
631

            
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
632
sub insert_timestamp {
633
    my $self = shift;
634
    
635
    if (@_) {
636
        $self->{insert_timestamp} = [@_];
637
        
638
        return $self;
639
    }
640
    return $self->{insert_timestamp};
641
}
642

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
643
sub include_model {
644
    my ($self, $name_space, $model_infos) = @_;
645
    
cleanup
Yuki Kimoto authored on 2011-04-02
646
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
647
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
648
    
649
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
650
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
651

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
652
        # Load name space module
cleanup
Yuki Kimoto authored on 2011-04-25
653
        croak qq{"$name_space" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
654
          if $name_space =~ /[^\w:]/;
655
        eval "use $name_space";
cleanup
Yuki Kimoto authored on 2011-04-25
656
        croak qq{Name space module "$name_space.pm" is needed. $@ }
657
            . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
658
          if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
659
        
660
        # Search model modules
661
        my $path = $INC{"$name_space.pm"};
662
        $path =~ s/\.pm$//;
663
        opendir my $dh, $path
cleanup
Yuki Kimoto authored on 2011-04-25
664
          or croak qq{Can't open directory "$path": $! } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
665
        $model_infos = [];
666
        while (my $module = readdir $dh) {
667
            push @$model_infos, $module
668
              if $module =~ s/\.pm$//;
669
        }
670
        close $dh;
671
    }
672
    
cleanup
Yuki Kimoto authored on 2011-04-02
673
    # Include models
cleanup
Yuki Kimoto authored on 2011-10-21
674
    for my $model_info (@$model_infos) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
675
        
cleanup
Yuki Kimoto authored on 2011-04-02
676
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
677
        my $model_class;
678
        my $model_name;
679
        my $model_table;
680
        if (ref $model_info eq 'HASH') {
681
            $model_class = $model_info->{class};
682
            $model_name  = $model_info->{name};
683
            $model_table = $model_info->{table};
684
            
685
            $model_name  ||= $model_class;
686
            $model_table ||= $model_name;
687
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
688
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
689
        my $mclass = "${name_space}::$model_class";
cleanup
Yuki Kimoto authored on 2011-04-25
690
        croak qq{"$mclass" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
691
          if $mclass =~ /[^\w:]/;
692
        unless ($mclass->can('isa')) {
693
            eval "use $mclass";
cleanup
Yuki Kimoto authored on 2011-04-25
694
            croak "$@ " . _subname if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
695
        }
696
        
cleanup
Yuki Kimoto authored on 2011-04-02
697
        # Create model
cleanup
Yuki Kimoto authored on 2011-10-21
698
        my $opt = {};
699
        $opt->{model_class} = $mclass if $mclass;
700
        $opt->{name}        = $model_name if $model_name;
701
        $opt->{table}       = $model_table if $model_table;
702
        $self->create_model($opt);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
703
    }
704
    
705
    return $self;
706
}
707

            
added EXPERIMENTAL like_valu...
Yuki Kimoto authored on 2011-09-16
708
sub like_value { sub { "%$_[0]%" } }
709

            
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
710
sub mapper {
711
    my $self = shift;
712
    return DBIx::Custom::Mapper->new(@_);
713
}
714

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
715
sub merge_param {
716
    my ($self, @params) = @_;
717
    
cleanup
Yuki Kimoto authored on 2011-04-02
718
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
719
    my $merge = {};
cleanup
Yuki Kimoto authored on 2011-10-21
720
    for my $param (@params) {
721
        for my $column (keys %$param) {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
722
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
723
            
724
            if (exists $merge->{$column}) {
725
                $merge->{$column} = [$merge->{$column}]
726
                  unless ref $merge->{$column} eq 'ARRAY';
727
                push @{$merge->{$column}},
728
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
729
            }
730
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
731
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
732
            }
733
        }
734
    }
735
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
736
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
737
}
738

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
739
sub model {
740
    my ($self, $name, $model) = @_;
741
    
cleanup
Yuki Kimoto authored on 2011-04-02
742
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
743
    if ($model) {
744
        $self->models->{$name} = $model;
745
        return $self;
746
    }
747
    
748
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
749
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
750
      unless $self->models->{$name};
751
    
cleanup
Yuki Kimoto authored on 2011-04-02
752
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
753
    return $self->models->{$name};
754
}
755

            
cleanup
Yuki Kimoto authored on 2011-03-21
756
sub mycolumn {
757
    my ($self, $table, $columns) = @_;
758
    
cleanup
Yuki Kimoto authored on 2011-04-02
759
    # Create column clause
760
    my @column;
cleanup
Yuki Kimoto authored on 2011-03-21
761
    $columns ||= [];
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
762
    push @column, $self->_q($table) . "." . $self->_q($_) .
763
      " as " . $self->_q($_)
764
      for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
765
    
766
    return join (', ', @column);
767
}
768

            
added dbi_options attribute
kimoto authored on 2010-12-20
769
sub new {
770
    my $self = shift->SUPER::new(@_);
771
    
cleanup
Yuki Kimoto authored on 2011-04-02
772
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
773
    my @attrs = keys %$self;
cleanup
Yuki Kimoto authored on 2011-10-21
774
    for my $attr (@attrs) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
775
        croak qq{Invalid attribute: "$attr" } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
776
          unless $self->can($attr);
777
    }
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
778

            
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
779
    # DEPRECATED
cleanup
Yuki Kimoto authored on 2011-08-13
780
    $self->{_tags} = {
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
781
        '?'     => \&DBIx::Custom::Tag::placeholder,
782
        '='     => \&DBIx::Custom::Tag::equal,
783
        '<>'    => \&DBIx::Custom::Tag::not_equal,
784
        '>'     => \&DBIx::Custom::Tag::greater_than,
785
        '<'     => \&DBIx::Custom::Tag::lower_than,
786
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
787
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
788
        'like'  => \&DBIx::Custom::Tag::like,
789
        'in'    => \&DBIx::Custom::Tag::in,
790
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
791
        'update_param' => \&DBIx::Custom::Tag::update_param
cleanup
Yuki Kimoto authored on 2011-08-13
792
    };
793
    
794
    return $self;
795
}
796

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
797
sub not_exists { DBIx::Custom::NotExists->singleton }
cleanup
Yuki Kimoto authored on 2011-08-13
798

            
799
sub order {
800
    my $self = shift;
801
    return DBIx::Custom::Order->new(dbi => $self, @_);
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
802
}
803

            
cleanup
yuki-kimoto authored on 2010-10-17
804
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
805
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
806
    
807
    # Register filter
808
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
809
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
810
    
cleanup
Yuki Kimoto authored on 2011-04-02
811
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
812
}
packaging one directory
yuki-kimoto authored on 2009-11-16
813

            
814
sub select {
cleanup
Yuki Kimoto authored on 2011-10-21
815
    my ($self, %opt) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
816

            
cleanup
Yuki Kimoto authored on 2011-10-21
817
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
818
    my $tables = ref $opt{table} eq 'ARRAY' ? $opt{table}
819
               : defined $opt{table} ? [$opt{table}]
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
820
               : [];
cleanup
Yuki Kimoto authored on 2011-10-21
821
    $opt{table} = $tables;
cleanup
Yuki Kimoto authored on 2011-10-21
822
    my $where_param = $opt{where_param} || delete $opt{param} || {};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
823
    
cleanup
Yuki Kimoto authored on 2011-03-09
824
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-10-21
825
    if ($opt{relation}) {
826
        warn "select() relation option is DEPRECATED!";
827
        $self->_add_relation_table($tables, $opt{relation});
828
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
829
    
cleanup
Yuki Kimoto authored on 2011-04-02
830
    # Select statement
micro optimization
Yuki Kimoto authored on 2011-09-30
831
    my $sql = 'select ';
packaging one directory
yuki-kimoto authored on 2009-11-16
832
    
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
833
    # Prefix
cleanup
Yuki Kimoto authored on 2011-10-21
834
    $sql .= "$opt{prefix} " if defined $opt{prefix};
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
835
    
cleanup
Yuki Kimoto authored on 2011-10-21
836
    # Column
cleanup
Yuki Kimoto authored on 2011-10-21
837
    if (defined $opt{column}) {
838
        my $columns
839
          = ref $opt{column} eq 'ARRAY' ? $opt{column} : [$opt{column}];
cleanup
Yuki Kimoto authored on 2011-10-21
840
        for my $column (@$columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-08
841
            if (ref $column eq 'HASH') {
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
842
                $column = $self->column(%$column) if ref $column eq 'HASH';
- select() column option can...
Yuki Kimoto authored on 2011-06-08
843
            }
844
            elsif (ref $column eq 'ARRAY') {
- select method column optio...
Yuki Kimoto authored on 2011-07-11
845
                if (@$column == 3 && $column->[1] eq 'as') {
846
                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
847
                    splice @$column, 1, 1;
848
                }
849
                
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
850
                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
- select() column option can...
Yuki Kimoto authored on 2011-06-08
851
            }
cleanup
Yuki Kimoto authored on 2011-04-02
852
            unshift @$tables, @{$self->_search_tables($column)};
micro optimization
Yuki Kimoto authored on 2011-09-30
853
            $sql .= "$column, ";
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
854
        }
micro optimization
Yuki Kimoto authored on 2011-09-30
855
        $sql =~ s/, $/ /;
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
856
    }
micro optimization
Yuki Kimoto authored on 2011-09-30
857
    else { $sql .= '* ' }
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
858
    
859
    # Table
micro optimization
Yuki Kimoto authored on 2011-09-30
860
    $sql .= 'from ';
cleanup
Yuki Kimoto authored on 2011-10-21
861
    if ($opt{relation}) {
cleanup
Yuki Kimoto authored on 2011-03-30
862
        my $found = {};
cleanup
Yuki Kimoto authored on 2011-10-21
863
        for my $table (@$tables) {
micro optimization
Yuki Kimoto authored on 2011-09-30
864
            $sql .= $self->_q($table) . ', ' unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
865
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
866
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
867
    }
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
868
    else { $sql .= $self->_q($tables->[-1] || '') . ' ' }
micro optimization
Yuki Kimoto authored on 2011-09-30
869
    $sql =~ s/, $/ /;
cleanup
Yuki Kimoto authored on 2011-10-21
870
    croak "select method table option must be specified " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
871
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
872

            
cleanup
Yuki Kimoto authored on 2011-04-02
873
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
874
    unshift @$tables,
875
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
876
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
877
    # Where
cleanup
Yuki Kimoto authored on 2011-10-21
878
    my $where = defined $opt{id}
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
879
              ? $self->_id_to_param(delete $opt{id}, $opt{primary_key}, $tables->[-1])
cleanup
Yuki Kimoto authored on 2011-10-21
880
              : $opt{where};
881
    my $w = $self->_where_clause_and_param($where, $where_param);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
882
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
883
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-10-21
884
    unshift @$tables, @{$self->_search_tables($w->{clause})};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
885
    
cleanup
Yuki Kimoto authored on 2011-10-21
886
    # Join statement
cleanup
Yuki Kimoto authored on 2011-10-21
887
    $self->_push_join(\$sql, $opt{join}, $tables) if defined $opt{join};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
888
    
cleanup
Yuki Kimoto authored on 2011-03-09
889
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-10-21
890
    $sql .= "$w->{clause} ";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
891
    
cleanup
Yuki Kimoto authored on 2011-03-08
892
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-10-21
893
    $self->_push_relation(\$sql, $tables, $opt{relation}, $w->{clause} eq '' ? 1 : 0)
cleanup
Yuki Kimoto authored on 2011-10-21
894
      if $opt{relation};
cleanup
Yuki Kimoto authored on 2011-03-08
895
    
packaging one directory
yuki-kimoto authored on 2009-11-16
896
    # Execute query
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
897
    $opt{statement} = 'select';
cleanup
Yuki Kimoto authored on 2011-10-21
898
    my $result = $self->execute($sql, $w->{param}, %opt);
packaging one directory
yuki-kimoto authored on 2009-11-16
899
    
micro optimization
Yuki Kimoto authored on 2011-10-23
900
    $result;
packaging one directory
yuki-kimoto authored on 2009-11-16
901
}
902

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
903
sub setup_model {
904
    my $self = shift;
905
    
cleanup
Yuki Kimoto authored on 2011-04-02
906
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
907
    $self->each_column(
908
        sub {
909
            my ($self, $table, $column, $column_info) = @_;
910
            if (my $model = $self->models->{$table}) {
911
                push @{$model->columns}, $column;
912
            }
913
        }
914
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
915
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
916
}
917

            
update pod
Yuki Kimoto authored on 2011-08-10
918
sub show_datatype {
919
    my ($self, $table) = @_;
920
    croak "Table name must be specified" unless defined $table;
921
    print "$table\n";
922
    
923
    my $result = $self->select(table => $table, where => "'0' <> '0'");
924
    my $sth = $result->sth;
925

            
926
    my $columns = $sth->{NAME};
927
    my $data_types = $sth->{TYPE};
928
    
929
    for (my $i = 0; $i < @$columns; $i++) {
930
        my $column = $columns->[$i];
931
        my $data_type = $data_types->[$i];
932
        print "$column: $data_type\n";
933
    }
934
}
935

            
936
sub show_typename {
937
    my ($self, $t) = @_;
938
    croak "Table name must be specified" unless defined $t;
939
    print "$t\n";
940
    
941
    $self->each_column(sub {
942
        my ($self, $table, $column, $infos) = @_;
943
        return unless $table eq $t;
944
        my $typename = $infos->{TYPE_NAME};
945
        print "$column: $typename\n";
946
    });
947
    
948
    return $self;
949
}
950

            
test cleanup
Yuki Kimoto authored on 2011-08-15
951
sub show_tables {
952
    my $self = shift;
953
    
954
    my %tables;
955
    $self->each_table(sub { $tables{$_[1]}++ });
956
    print join("\n", sort keys %tables) . "\n";
957
    return $self;
958
}
959

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
960
sub type_rule {
961
    my $self = shift;
micro optimization
Yuki Kimoto authored on 2011-10-23
962

            
963
    $self->{_type_rule_is_called} = 1;
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
964
    
965
    if (@_) {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
966
        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
967
        
968
        # Into
cleanup
Yuki Kimoto authored on 2011-10-21
969
        for my $i (1 .. 2) {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
970
            my $into = "into$i";
cleanup
Yuki Kimoto authored on 2011-08-16
971
            my $exists_into = exists $type_rule->{$into};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
972
            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
973
            $self->{type_rule} = $type_rule;
974
            $self->{"_$into"} = {};
cleanup
Yuki Kimoto authored on 2011-10-21
975
            for my $type_name (keys %{$type_rule->{$into} || {}}) {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
976
                croak qq{type name of $into section must be lower case}
977
                  if $type_name =~ /[A-Z]/;
978
            }
cleanup
Yuki Kimoto authored on 2011-08-16
979
            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
980
            $self->each_column(sub {
981
                my ($dbi, $table, $column, $column_info) = @_;
982
                
983
                my $type_name = lc $column_info->{TYPE_NAME};
984
                if ($type_rule->{$into} &&
985
                    (my $filter = $type_rule->{$into}->{$type_name}))
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
986
                {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
987
                    return unless exists $type_rule->{$into}->{$type_name};
988
                    if  (defined $filter && ref $filter ne 'CODE') 
989
                    {
990
                        my $fname = $filter;
991
                        croak qq{Filter "$fname" is not registered" } . _subname
992
                          unless exists $self->filters->{$fname};
993
                        
994
                        $filter = $self->filters->{$fname};
995
                    }
996

            
micro optimization
Yuki Kimoto authored on 2011-07-30
997
                    $self->{"_$into"}{key}{$table}{$column} = $filter;
998
                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
999
                }
1000
            });
1001
        }
1002

            
1003
        # From
cleanup
Yuki Kimoto authored on 2011-10-21
1004
        for my $i (1 .. 2) {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1005
            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
cleanup
Yuki Kimoto authored on 2011-10-21
1006
            for my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1007
                croak qq{data type of from$i section must be lower case or number}
1008
                  if $data_type =~ /[A-Z]/;
1009
                my $fname = $type_rule->{"from$i"}{$data_type};
1010
                if (defined $fname && ref $fname ne 'CODE') {
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1011
                    croak qq{Filter "$fname" is not registered" } . _subname
1012
                      unless exists $self->filters->{$fname};
1013
                    
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1014
                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1015
                }
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1016
            }
1017
        }
1018
        
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1019
        return $self;
1020
    }
1021
    
1022
    return $self->{type_rule} || {};
1023
}
1024

            
cleanup
yuki-kimoto authored on 2010-10-17
1025
sub update {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1026
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1027

            
cleanup
Yuki Kimoto authored on 2011-10-21
1028
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
1029
    my $param = @_ % 2 ? shift : undef;
cleanup
Yuki Kimoto authored on 2011-10-21
1030
    my %opt = @_;
cleanup
Yuki Kimoto authored on 2011-10-21
1031
    warn "update param option is DEPRECATED!" if $opt{param};
cleanup
Yuki Kimoto authored on 2011-10-21
1032
    warn "update method where_param option is DEPRECATED!"
1033
      if $opt{where_param};
cleanup
Yuki Kimoto authored on 2011-10-21
1034
    $param ||= $opt{param} || {};
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
1035
    
cleanup
Yuki Kimoto authored on 2011-10-21
1036
    # Don't allow update all rows
1037
    croak qq{update method where option must be specified } . _subname
1038
      if !$opt{where} && !defined $opt{id} && !$opt{allow_update_all};
1039
    
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
1040
    # Timestamp
cleanup
Yuki Kimoto authored on 2011-10-21
1041
    if ($opt{timestamp} && (my $update_timestamp = $self->update_timestamp)) {
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
1042
        my $columns = $update_timestamp->[0];
1043
        $columns = [$columns] unless ref $columns eq 'ARRAY';
1044
        my $value = $update_timestamp->[1];
1045
        $value = $value->() if ref $value eq 'CODE';
1046
        $param->{$_} = $value for @$columns;
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
1047
    }
1048

            
cleanup
Yuki Kimoto authored on 2011-10-21
1049
    # Assign clause
cleanup
Yuki Kimoto authored on 2011-10-21
1050
    my $assign_clause = $self->assign_clause($param, {wrap => $opt{wrap}});
cleanup
Yuki Kimoto authored on 2011-10-21
1051
    
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1052
    # Where
cleanup
Yuki Kimoto authored on 2011-10-25
1053
    my $w = $self->_where_clause_and_param($opt{where}, $opt{where_param},
1054
      delete $opt{id}, $opt{primary_key}, $opt{table});
removed reconnect method
yuki-kimoto authored on 2010-05-28
1055
    
cleanup
Yuki Kimoto authored on 2011-10-21
1056
    # Merge where parameter to parameter
cleanup
Yuki Kimoto authored on 2011-10-21
1057
    $param = $self->merge_param($param, $w->{param}) if keys %{$w->{param}};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1058
    
cleanup
Yuki Kimoto authored on 2011-04-02
1059
    # Update statement
cleanup
Yuki Kimoto authored on 2011-10-21
1060
    my $sql = "update ";
1061
    $sql .= "$opt{prefix} " if defined $opt{prefix};
cleanup
Yuki Kimoto authored on 2011-10-21
1062
    $sql .= $self->_q($opt{table}) . " set $assign_clause $w->{clause} ";
cleanup
Yuki Kimoto authored on 2011-01-27
1063
    
cleanup
yuki-kimoto authored on 2010-10-17
1064
    # Execute query
- insert method id value is ...
Yuki Kimoto authored on 2011-10-25
1065
    $opt{statement} = 'update';
micro optimization
Yuki Kimoto authored on 2011-10-23
1066
    $self->execute($sql, $param, %opt);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1067
}
1068

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

            
cleanup
Yuki Kimoto authored on 2011-10-21
1071
sub update_or_insert {
1072
    my $self = shift;
1073

            
cleanup
Yuki Kimoto authored on 2011-10-21
1074
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
1075
    my $param  = shift;
1076
    my %opt = @_;
1077
    my $id = $opt{id};
1078
    my $primary_key = $opt{primary_key};
1079
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
1080
    croak "update_or_insert method need primary_key option " .
1081
          "when id is specified" . _subname
1082
      if defined $id && !defined $primary_key;
1083
    my $table  = $opt{table};
1084
    croak qq{"table" option must be specified } . _subname
1085
      unless defined $table;
1086
    my $select_option = $opt{select_option};
1087
    
1088
    my $rows = $self->select(table => $table, id => $id,
1089
        primary_key => $primary_key, %$select_option)->all;
1090
    
1091
    croak "selected row count must be one or zero" . _subname
1092
      if @$rows > 1;
1093
    
1094
    my $row = $rows->[0];
1095
    my @opt = (table => $table);
1096
    push @opt, id => $id, primary_key => $primary_key if defined $id;
1097
    push @opt, %opt;
1098
    
1099
    if ($row) {
1100
        return $self->update($param, @opt);
1101
    }
1102
    else {
1103
        return $self->insert($param, @opt);
1104
    }
1105
}
1106

            
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
1107
sub update_timestamp {
1108
    my $self = shift;
1109
    
1110
    if (@_) {
1111
        $self->{update_timestamp} = [@_];
1112
        
1113
        return $self;
1114
    }
1115
    return $self->{update_timestamp};
1116
}
1117

            
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
1118
sub values_clause {
1119
    my ($self, $param, $opts) = @_;
1120
    
1121
    my $wrap = $opts->{wrap} || {};
1122
    
1123
    # Create insert parameter tag
micro optimization
Yuki Kimoto authored on 2011-10-23
1124
    my $safety = $self->{safety_character} || $self->safety_character;
improved performance
Yuki Kimoto authored on 2011-10-22
1125
    my $qp = $self->_q('');
fixed some quoted bug
Yuki Kimoto authored on 2011-10-22
1126
    my $q = substr($qp, 0, 1) || '';
1127
    my $p = substr($qp, 1, 1) || '';
improved performance
Yuki Kimoto authored on 2011-10-22
1128
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1129
    # Check unsafety keys
1130
    unless ((join('', keys %$param) || '') =~ /^[$safety\.]+$/) {
1131
        for my $column (keys %$param) {
1132
            croak qq{"$column" is not safety column name } . _subname
1133
              unless $column =~ /^[$safety\.]+$/;
1134
        }
1135
    }
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
1136
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1137
    # values clause(performance is important)
micro optimization
Yuki Kimoto authored on 2011-10-23
1138
    '(' .
1139
    join(
1140
      ', ',
1141
      map { "$q$_$p" } sort keys %$param
1142
    ) .
1143
    ') values (' .
1144
    join(
1145
      ', ',
1146
      map {
1147
          ref $param->{$_} eq 'SCALAR' ? ${$param->{$_}} :
1148
          $wrap->{$_} ? $wrap->{$_}->(":$_") :
1149
          ":$_";
1150
      } sort keys %$param
1151
    ) .
1152
    ')'
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
1153
}
1154

            
sub module use DBIx::Custom ...
Yuki Kimoto authored on 2011-08-02
1155
sub where { DBIx::Custom::Where->new(dbi => shift, @_) }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1156

            
updated pod
Yuki Kimoto authored on 2011-06-21
1157
sub _create_query {
cleanup
Yuki Kimoto authored on 2011-06-13
1158
    
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
1159
    my ($self, $source, $after_build_sql) = @_;
cleanup
Yuki Kimoto authored on 2011-06-13
1160
    
updated pod
Yuki Kimoto authored on 2011-06-21
1161
    # Cache
1162
    my $cache = $self->cache;
1163
    
1164
    # Query
1165
    my $query;
1166
    
1167
    # Get cached query
1168
    if ($cache) {
cleanup
Yuki Kimoto authored on 2011-06-13
1169
        
updated pod
Yuki Kimoto authored on 2011-06-21
1170
        # Get query
1171
        my $q = $self->cache_method->($self, $source);
cleanup
Yuki Kimoto authored on 2011-06-13
1172
        
updated pod
Yuki Kimoto authored on 2011-06-21
1173
        # Create query
1174
        if ($q) {
1175
            $query = DBIx::Custom::Query->new($q);
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
1176
            $query->{filters} = $self->filters;
cleanup
Yuki Kimoto authored on 2011-06-13
1177
        }
updated pod
Yuki Kimoto authored on 2011-06-21
1178
    }
1179
    
1180
    # Create query
1181
    unless ($query) {
1182

            
1183
        # Create query
1184
        my $builder = $self->query_builder;
1185
        $query = $builder->build_query($source);
1186

            
1187
        # Remove reserved word quote
1188
        if (my $q = $self->_quote) {
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1189
            $q = quotemeta($q);
1190
            $_ =~ s/[$q]//g for @{$query->columns}
cleanup
Yuki Kimoto authored on 2011-06-13
1191
        }
updated pod
Yuki Kimoto authored on 2011-06-21
1192

            
1193
        # Save query to cache
1194
        $self->cache_method->(
1195
            $self, $source,
1196
            {
1197
                sql     => $query->sql, 
1198
                columns => $query->columns,
DBIx::Custom::Query tables a...
Yuki Kimoto authored on 2011-07-30
1199
                tables  => $query->{tables} || []
updated pod
Yuki Kimoto authored on 2011-06-21
1200
            }
1201
        ) if $cache;
cleanup
Yuki Kimoto authored on 2011-06-13
1202
    }
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
1203

            
1204
    # Filter SQL
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
1205
    if ($after_build_sql) {
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
1206
        my $sql = $query->sql;
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
1207
        $sql = $after_build_sql->($sql);
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
1208
        $query->sql($sql);
1209
    }
1210
        
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
1211
    # Save sql
1212
    $self->last_sql($query->sql);
1213
    
updated pod
Yuki Kimoto authored on 2011-06-21
1214
    # Prepare statement handle
1215
    my $sth;
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
1216
    eval { $sth = $self->dbh->prepare($query->{sql}) };
updated pod
Yuki Kimoto authored on 2011-06-21
1217
    
1218
    if ($@) {
1219
        $self->_croak($@, qq{. Following SQL is executed.\n}
1220
                        . qq{$query->{sql}\n} . _subname);
1221
    }
1222
    
1223
    # Set statement handle
1224
    $query->sth($sth);
1225
    
1226
    # Set filters
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
1227
    $query->{filters} = $self->filters;
updated pod
Yuki Kimoto authored on 2011-06-21
1228
    
1229
    return $query;
cleanup
Yuki Kimoto authored on 2011-06-13
1230
}
1231

            
cleanup
Yuki Kimoto authored on 2011-04-02
1232
sub _create_bind_values {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1233
    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1234
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1235
    $bind_type = _array_to_hash($bind_type) if ref $bind_type eq 'ARRAY';
1236
    
cleanup
Yuki Kimoto authored on 2011-04-02
1237
    # Create bind values
micro optimization
Yuki Kimoto authored on 2011-10-23
1238
    my @bind;
1239
    my @types;
1240
    my %count;
1241
    my %not_exists;
cleanup
Yuki Kimoto authored on 2011-10-21
1242
    for my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1243
        
micro optimization
Yuki Kimoto authored on 2011-10-23
1244
        # Bind value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1245
        if(ref $params->{$column} eq 'ARRAY') {
micro optimization
Yuki Kimoto authored on 2011-10-23
1246
            my $i = $count{$column} || 0;
1247
            $i += $not_exists{$column} || 0;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1248
            my $found;
1249
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1250
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
micro optimization
Yuki Kimoto authored on 2011-10-23
1251
                    $not_exists{$column}++;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1252
                }
1253
                else  {
micro optimization
Yuki Kimoto authored on 2011-10-23
1254
                    push @bind, $params->{$column}->[$k];
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1255
                    $found = 1;
1256
                    last
1257
                }
1258
            }
1259
            next unless $found;
1260
        }
micro optimization
Yuki Kimoto authored on 2011-10-23
1261
        else { push @bind, $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1262
        
cleanup
Yuki Kimoto authored on 2011-01-12
1263
        # Filter
micro optimization
Yuki Kimoto authored on 2011-10-23
1264
        if (my $f = $filter->{$column} || $self->{default_out_filter} || '') {
micro optimization
Yuki Kimoto authored on 2011-10-23
1265
            $bind[-1] = $f->($bind[-1]);
micro optimization
Yuki Kimoto authored on 2011-10-23
1266
        }
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
1267
        
1268
        # Type rule
micro optimization
Yuki Kimoto authored on 2011-10-23
1269
        if ($self->{_type_rule_is_called}) {
1270
            my $tf1 = $self->{"_into1"}->{dot}->{$column}
1271
              || $type_filters->{1}->{$column};
micro optimization
Yuki Kimoto authored on 2011-10-23
1272
            $bind[-1] = $tf1->($bind[-1]) if $tf1;
micro optimization
Yuki Kimoto authored on 2011-10-23
1273
            my $tf2 = $self->{"_into2"}->{dot}->{$column}
1274
              || $type_filters->{2}->{$column};
micro optimization
Yuki Kimoto authored on 2011-10-23
1275
            $bind[-1] = $tf2->($bind[-1]) if $tf2;
micro optimization
Yuki Kimoto authored on 2011-10-23
1276
        }
micro optimization
Yuki Kimoto authored on 2011-10-22
1277
       
micro optimization
Yuki Kimoto authored on 2011-10-23
1278
        # Bind types
micro optimization
Yuki Kimoto authored on 2011-10-23
1279
        push @types, $bind_type->{$column};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1280
        
1281
        # Count up 
micro optimization
Yuki Kimoto authored on 2011-10-23
1282
        $count{$column}++;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1283
    }
1284
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1285
    return (\@bind, \@types);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1286
}
1287

            
cleanup
Yuki Kimoto authored on 2011-10-21
1288
sub _id_to_param {
fixed id option bug when col...
Yuki Kimoto authored on 2011-10-10
1289
    my ($self, $id, $primary_keys, $table) = @_;
cleanup
Yuki Kimoto authored on 2011-10-21
1290
    
1291
    # Check primary key
cleanup
Yuki Kimoto authored on 2011-10-21
1292
    croak "primary_key option " .
1293
          "must be specified with id option " . _subname
1294
      unless defined $primary_keys;
1295
    $primary_keys = [$primary_keys] unless ref $primary_keys eq 'ARRAY';
improved error messages
Yuki Kimoto authored on 2011-04-18
1296
    
cleanup
Yuki Kimoto authored on 2011-06-08
1297
    # Create parameter
1298
    my $param = {};
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
1299
    if (defined $id) {
cleanup
Yuki Kimoto authored on 2011-06-08
1300
        $id = [$id] unless ref $id;
1301
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1302
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1303
          unless !ref $id || ref $id eq 'ARRAY';
1304
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1305
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1306
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1307
        for(my $i = 0; $i < @$primary_keys; $i ++) {
fixed id option bug when col...
Yuki Kimoto authored on 2011-10-10
1308
           my $key = $primary_keys->[$i];
1309
           $key = "$table." . $key if $table;
1310
           $param->{$key} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1311
        }
1312
    }
1313
    
cleanup
Yuki Kimoto authored on 2011-06-08
1314
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1315
}
1316

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1317
sub _connect {
1318
    my $self = shift;
1319
    
1320
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1321
    my $dsn = $self->data_source;
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1322
    warn "data_source is DEPRECATED!\n"
fixed bug that data_source D...
Yuki Kimoto authored on 2011-06-13
1323
      if $dsn;
added warnings
Yuki Kimoto authored on 2011-06-07
1324
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1325
    croak qq{"dsn" must be specified } . _subname
1326
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1327
    my $user        = $self->user;
1328
    my $password    = $self->password;
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
1329
    my $option = $self->_option;
1330
    $option = {%{$self->default_option}, %$option};
cleanup
Yuki Kimoto authored on 2011-08-16
1331
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1332
    # Connect
cleanup
Yuki Kimoto authored on 2011-08-16
1333
    my $dbh;
1334
    eval {
1335
        $dbh = DBI->connect(
1336
            $dsn,
1337
            $user,
1338
            $password,
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
1339
            $option
cleanup
Yuki Kimoto authored on 2011-08-16
1340
        );
1341
    };
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1342
    
1343
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1344
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1345
    
1346
    return $dbh;
1347
}
1348

            
cleanup
yuki-kimoto authored on 2010-10-17
1349
sub _croak {
1350
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1351
    
1352
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1353
    $append ||= "";
1354
    
1355
    # Verbose
1356
    if ($Carp::Verbose) { croak $error }
1357
    
1358
    # Not verbose
1359
    else {
1360
        
1361
        # Remove line and module infromation
1362
        my $at_pos = rindex($error, ' at ');
1363
        $error = substr($error, 0, $at_pos);
1364
        $error =~ s/\s+$//;
1365
        croak "$error$append";
1366
    }
1367
}
1368

            
prepare oracle test
Yuki Kimoto authored on 2011-08-15
1369
sub _driver { lc shift->{dbh}->{Driver}->{Name} }
1370

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1371
sub _need_tables {
1372
    my ($self, $tree, $need_tables, $tables) = @_;
1373
    
cleanup
Yuki Kimoto authored on 2011-04-02
1374
    # Get needed tables
cleanup
Yuki Kimoto authored on 2011-10-21
1375
    for my $table (@$tables) {
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1376
        if ($tree->{$table}) {
1377
            $need_tables->{$table} = 1;
1378
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1379
        }
1380
    }
1381
}
1382

            
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
1383
sub _option {
1384
    my $self = shift;
1385
    my $option = {%{$self->dbi_options}, %{$self->dbi_option}, %{$self->option}};
1386
    warn "dbi_options is DEPRECATED! use option instead\n"
1387
      if keys %{$self->dbi_options};
1388
    warn "dbi_option is DEPRECATED! use option instead\n"
1389
      if keys %{$self->dbi_option};
1390
    return $option;
1391
}
1392

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1393
sub _push_join {
1394
    my ($self, $sql, $join, $join_tables) = @_;
1395
    
cleanup
Yuki Kimoto authored on 2011-10-21
1396
    $join = [$join] unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-10-21
1397
    
cleanup
Yuki Kimoto authored on 2011-04-02
1398
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1399
    return unless @$join;
1400
    
cleanup
Yuki Kimoto authored on 2011-04-02
1401
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1402
    my $tree = {};
1403
    for (my $i = 0; $i < @$join; $i++) {
1404
        
cleanup
Yuki Kimoto authored on 2011-07-28
1405
        # Arrange
added join new syntax
Yuki Kimoto authored on 2011-07-28
1406
        my $join_clause;;
1407
        my $option;
1408
        if (ref $join->[$i] eq 'HASH') {
1409
            $join_clause = $join->[$i]->{clause};
1410
            $option = {table => $join->[$i]->{table}};
1411
        }
1412
        else {
1413
            $join_clause = $join->[$i];
1414
            $option = {};
1415
        };
cleanup
Yuki Kimoto authored on 2011-07-28
1416

            
1417
        # Find tables in join clause
added join new syntax
Yuki Kimoto authored on 2011-07-28
1418
        my $table1;
1419
        my $table2;
1420
        if (my $table = $option->{table}) {
1421
            $table1 = $table->[0];
1422
            $table2 = $table->[1];
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1423
        }
cleanup
Yuki Kimoto authored on 2011-07-28
1424
        else {
1425
            my $q = $self->_quote;
1426
            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1427
            $j_clause =~ s/'.+?'//g;
1428
            my $q_re = quotemeta($q);
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1429
            $j_clause =~ s/[$q_re]//g;
improved join clause parsing
Yuki Kimoto authored on 2011-09-27
1430
            
1431
            my @j_clauses = reverse split /\s(and|on)\s/, $j_clause;
cleanup
Yuki Kimoto authored on 2011-07-28
1432
            my $c = $self->safety_character;
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
1433
            my $join_re = qr/($c+)\.$c+[^$c].*?($c+)\.$c+/sm;
improved join clause parsing
Yuki Kimoto authored on 2011-09-27
1434
            for my $clause (@j_clauses) {
1435
                if ($clause =~ $join_re) {
1436
                    $table1 = $1;
1437
                    $table2 = $2;
1438
                    last;
1439
                }                
cleanup
Yuki Kimoto authored on 2011-07-28
1440
            }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1441
        }
added join new syntax
Yuki Kimoto authored on 2011-07-28
1442
        croak qq{join clause must have two table name after "on" keyword. } .
1443
              qq{"$join_clause" is passed }  . _subname
1444
          unless defined $table1 && defined $table2;
1445
        croak qq{right side table of "$join_clause" must be unique }
1446
            . _subname
1447
          if exists $tree->{$table2};
1448
        croak qq{Same table "$table1" is specified} . _subname
1449
          if $table1 eq $table2;
1450
        $tree->{$table2}
1451
          = {position => $i, parent => $table1, join => $join_clause};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1452
    }
1453
    
cleanup
Yuki Kimoto authored on 2011-04-02
1454
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1455
    my $need_tables = {};
1456
    $self->_need_tables($tree, $need_tables, $join_tables);
cleanup
Yuki Kimoto authored on 2011-10-21
1457
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} }
1458
      keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1459
    
1460
    # Add join clause
cleanup
Yuki Kimoto authored on 2011-10-21
1461
    $$sql .= $tree->{$_}{join} . ' ' for @need_tables;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1462
}
cleanup
Yuki Kimoto authored on 2011-03-08
1463

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1464
sub _quote {
1465
    my $self = shift;
micro optimization
Yuki Kimoto authored on 2011-10-22
1466
    return $self->{reserved_word_quote} || $self->quote || '';
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1467
}
1468

            
cleanup
Yuki Kimoto authored on 2011-07-29
1469
sub _q {
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1470
    my ($self, $value, $quotemeta) = @_;
cleanup
Yuki Kimoto authored on 2011-07-29
1471
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1472
    my $quote = $self->{reserved_word_quote}
1473
      || $self->{quote} || $self->quote || '';
1474
    return "$quote$value$quote"
1475
      if !$quotemeta && ($quote eq '`' || $quote eq '"');
1476
    
cleanup
Yuki Kimoto authored on 2011-07-29
1477
    my $q = substr($quote, 0, 1) || '';
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1478
    my $p;
1479
    if (defined $quote && length $quote > 1) {
1480
        $p = substr($quote, 1, 1);
1481
    }
1482
    else { $p = $q }
cleanup
Yuki Kimoto authored on 2011-07-29
1483
    
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1484
    if ($quotemeta) {
1485
        $q = quotemeta($q);
1486
        $p = quotemeta($p);
1487
    }
1488
    
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1489
    return "$q$value$p";
cleanup
Yuki Kimoto authored on 2011-07-29
1490
}
1491

            
cleanup
Yuki Kimoto authored on 2011-04-02
1492
sub _remove_duplicate_table {
1493
    my ($self, $tables, $main_table) = @_;
1494
    
1495
    # Remove duplicate table
1496
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1497
    delete $tables{$main_table} if $main_table;
1498
    
micro optimization
Yuki Kimoto authored on 2011-07-30
1499
    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1500
    if (my $q = $self->_quote) {
1501
        $q = quotemeta($q);
1502
        $_ =~ s/[$q]//g for @$new_tables;
1503
    }
1504

            
1505
    return $new_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1506
}
1507

            
cleanup
Yuki Kimoto authored on 2011-04-02
1508
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1509
    my ($self, $source) = @_;
1510
    
cleanup
Yuki Kimoto authored on 2011-04-02
1511
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1512
    my $tables = [];
1513
    my $safety_character = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1514
    my $q = $self->_quote;
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1515
    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)", 1);
1516
    my $table_re = $q ? qr/(?:^|[^$safety_character])${quoted_safety_character_re}?\./
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1517
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1518
    while ($source =~ /$table_re/g) {
1519
        push @$tables, $1;
1520
    }
1521
    
1522
    return $tables;
1523
}
1524

            
cleanup
Yuki Kimoto authored on 2011-10-21
1525
sub _where_clause_and_param {
cleanup
Yuki Kimoto authored on 2011-10-25
1526
    my ($self, $where, $where_param, $id, $primary_key, $table) = @_;
cleanup
Yuki Kimoto authored on 2011-10-25
1527

            
cleanup
Yuki Kimoto authored on 2011-10-21
1528
    $where ||= {};
cleanup
Yuki Kimoto authored on 2011-10-25
1529
    $where = $self->_id_to_param($id, $primary_key, $table) if defined $id;
cleanup
Yuki Kimoto authored on 2011-10-25
1530
    $where_param ||= {};
cleanup
Yuki Kimoto authored on 2011-10-21
1531
    my $w = {};
1532
    my $where_clause = '';
cleanup
Yuki Kimoto authored on 2011-10-25
1533

            
cleanup
Yuki Kimoto authored on 2011-10-25
1534
    my $obj;
1535
    
cleanup
Yuki Kimoto authored on 2011-10-21
1536
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1537
        $w->{clause} = "where " . $where->[0];
1538
        $w->{param} = $where->[1];
1539
    }
1540
    elsif (ref $where) {
cleanup
Yuki Kimoto authored on 2011-10-25
1541

            
1542
        # Hash
1543
        if (ref $where eq 'HASH') {
1544
            my $clause = ['and'];
1545
            my $q = $self->_quote;
1546
            for my $column (keys %$where) {
1547
                my $table;
1548
                my $c;
1549
                if ($column =~ /(?:(.*?)\.)?(.*)/) {
1550
                    $table = $1;
1551
                    $c = $2;
1552
                }
1553
                
1554
                my $table_quote;
1555
                $table_quote = $self->_q($table) if defined $table;
1556
                my $column_quote = $self->_q($c);
1557
                $column_quote = $table_quote . '.' . $column_quote
1558
                  if defined $table_quote;
1559
                push @$clause, "$column_quote = :$column" for keys %$where;
1560
            }
1561
            $obj = $self->where(clause => $clause, param => $where);
1562
        }
1563
        
1564
        # DBIx::Custom::Where object
1565
        elsif (ref $where eq 'DBIx::Custom::Where') {
1566
            $obj = $where;
1567
        }
1568
        
1569
        # Array
1570
        elsif (ref $where eq 'ARRAY') {
1571
            $obj = $self->where(
1572
                clause => $where->[0],
1573
                param  => $where->[1]
1574
            );
1575
        }
1576
        
1577
        # Check where argument
1578
        croak qq{"where" must be hash reference or DBIx::Custom::Where object}
1579
            . qq{or array reference, which contains where clause and parameter}
1580
            . _subname
1581
          unless ref $obj eq 'DBIx::Custom::Where';
1582

            
1583

            
1584
        $w->{param} = keys %$where_param
1585
                    ? $self->merge_param($where_param, $obj->param)
1586
                    : $obj->param;
1587
        $w->{clause} = $obj->to_string;
cleanup
Yuki Kimoto authored on 2011-10-21
1588
    }
1589
    elsif ($where) {
1590
        $w->{clause} = "where $where";
cleanup
Yuki Kimoto authored on 2011-10-25
1591
        $w->{param} = $where_param;
cleanup
Yuki Kimoto authored on 2011-10-21
1592
    }
1593
    
1594
    return $w;
1595
}
1596

            
updated pod
Yuki Kimoto authored on 2011-06-21
1597
sub _apply_filter {
1598
    my ($self, $table, @cinfos) = @_;
1599

            
1600
    # Initialize filters
1601
    $self->{filter} ||= {};
micro optimization
Yuki Kimoto authored on 2011-07-30
1602
    $self->{filter}{on} = 1;
updated pod
Yuki Kimoto authored on 2011-06-21
1603
    $self->{filter}{out} ||= {};
1604
    $self->{filter}{in} ||= {};
1605
    $self->{filter}{end} ||= {};
1606
    
1607
    # Usage
1608
    my $usage = "Usage: \$dbi->apply_filter(" .
1609
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1610
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1611
    
1612
    # Apply filter
1613
    for (my $i = 0; $i < @cinfos; $i += 2) {
1614
        
1615
        # Column
1616
        my $column = $cinfos[$i];
1617
        if (ref $column eq 'ARRAY') {
cleanup
Yuki Kimoto authored on 2011-10-21
1618
            for my $c (@$column) {
updated pod
Yuki Kimoto authored on 2011-06-21
1619
                push @cinfos, $c, $cinfos[$i + 1];
1620
            }
1621
            next;
1622
        }
1623
        
1624
        # Filter infomation
1625
        my $finfo = $cinfos[$i + 1] || {};
1626
        croak "$usage (table: $table) " . _subname
1627
          unless  ref $finfo eq 'HASH';
cleanup
Yuki Kimoto authored on 2011-10-21
1628
        for my $ftype (keys %$finfo) {
updated pod
Yuki Kimoto authored on 2011-06-21
1629
            croak "$usage (table: $table) " . _subname
1630
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1631
        }
1632
        
1633
        # Set filters
cleanup
Yuki Kimoto authored on 2011-10-21
1634
        for my $way (qw/in out end/) {
updated pod
Yuki Kimoto authored on 2011-06-21
1635
        
1636
            # Filter
1637
            my $filter = $finfo->{$way};
1638
            
1639
            # Filter state
1640
            my $state = !exists $finfo->{$way} ? 'not_exists'
1641
                      : !defined $filter        ? 'not_defined'
1642
                      : ref $filter eq 'CODE'   ? 'code'
1643
                      : 'name';
1644
            
1645
            # Filter is not exists
1646
            next if $state eq 'not_exists';
1647
            
1648
            # Check filter name
1649
            croak qq{Filter "$filter" is not registered } . _subname
1650
              if  $state eq 'name'
1651
               && ! exists $self->filters->{$filter};
1652
            
1653
            # Set filter
1654
            my $f = $state eq 'not_defined' ? undef
1655
                  : $state eq 'code'        ? $filter
1656
                  : $self->filters->{$filter};
1657
            $self->{filter}{$way}{$table}{$column} = $f;
1658
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1659
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1660
            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1661
        }
1662
    }
1663
    
1664
    return $self;
1665
}
1666

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
1667
# DEPRECATED!
1668
has 'data_source';
1669
has dbi_options => sub { {} };
1670
has filter_check  => 1;
1671
has 'reserved_word_quote';
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
1672
has dbi_option => sub { {} };
1673
has default_dbi_option => sub {
1674
    warn "default_dbi_option is DEPRECATED! use default_option instead";
1675
    return shift->default_option;
1676
};
1677

            
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
1678
# DEPRECATED!
1679
sub method {
1680
    warn "method is DEPRECATED! use helper instead";
1681
    return shift->helper(@_);
1682
}
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
1683

            
1684
# DEPRECATED!
1685
sub assign_param {
1686
    my $self = shift;
1687
    warn "assing_param is DEPRECATED! use assign_clause instead";
1688
    return $self->assign_clause(@_);
1689
}
1690

            
1691
# DEPRECATED
1692
sub update_param {
1693
    my ($self, $param, $opts) = @_;
1694
    
micro optimization
Yuki Kimoto authored on 2011-10-23
1695
    warn "update_param is DEPRECATED! use assign_clause instead.";
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
1696
    
1697
    # Create update parameter tag
1698
    my $tag = $self->assign_clause($param, $opts);
1699
    $tag = "set $tag" unless $opts->{no_set};
1700

            
1701
    return $tag;
1702
}
1703

            
updated pod
Yuki Kimoto authored on 2011-06-21
1704
# DEPRECATED!
1705
sub create_query {
1706
    warn "create_query is DEPRECATED! use query option of each method";
1707
    shift->_create_query(@_);
1708
}
1709

            
cleanup
Yuki Kimoto authored on 2011-06-13
1710
# DEPRECATED!
1711
sub apply_filter {
1712
    my $self = shift;
1713
    
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1714
    warn "apply_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-06-13
1715
    return $self->_apply_filter(@_);
1716
}
1717

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1718
# DEPRECATED!
1719
sub select_at {
cleanup
Yuki Kimoto authored on 2011-10-21
1720
    my ($self, %opt) = @_;
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1721

            
cleanup
Yuki Kimoto authored on 2011-10-21
1722
    warn "select_at is DEPRECATED! use select method id option instead";
updated pod
Yuki Kimoto authored on 2011-06-08
1723

            
cleanup
Yuki Kimoto authored on 2011-10-21
1724
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
1725
    my $primary_keys = delete $opt{primary_key};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1726
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-10-21
1727
    my $where = delete $opt{where};
1728
    my $param = delete $opt{param};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1729
    
1730
    # Table
1731
    croak qq{"table" option must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-10-21
1732
      unless $opt{table};
1733
    my $table = ref $opt{table} ? $opt{table}->[-1] : $opt{table};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1734
    
1735
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-10-21
1736
    my $where_param = $self->_id_to_param($where, $primary_keys);
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1737
    
cleanup
Yuki Kimoto authored on 2011-10-21
1738
    return $self->select(where => $where_param, %opt);
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1739
}
1740

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1741
# DEPRECATED!
1742
sub delete_at {
cleanup
Yuki Kimoto authored on 2011-10-21
1743
    my ($self, %opt) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1744

            
cleanup
Yuki Kimoto authored on 2011-10-21
1745
    warn "delete_at is DEPRECATED! use delete method id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1746
    
cleanup
Yuki Kimoto authored on 2011-10-21
1747
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
1748
    my $primary_keys = delete $opt{primary_key};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1749
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-10-21
1750
    my $where = delete $opt{where};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1751
    
1752
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-10-21
1753
    my $where_param = $self->_id_to_param($where, $primary_keys);
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1754
    
cleanup
Yuki Kimoto authored on 2011-10-21
1755
    return $self->delete(where => $where_param, %opt);
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1756
}
1757

            
cleanup
Yuki Kimoto authored on 2011-06-08
1758
# DEPRECATED!
1759
sub update_at {
1760
    my $self = shift;
1761

            
cleanup
Yuki Kimoto authored on 2011-10-21
1762
    warn "update_at is DEPRECATED! use update method id option instead";
cleanup
Yuki Kimoto authored on 2011-06-08
1763
    
cleanup
Yuki Kimoto authored on 2011-10-21
1764
    # Options
cleanup
Yuki Kimoto authored on 2011-06-08
1765
    my $param;
1766
    $param = shift if @_ % 2;
cleanup
Yuki Kimoto authored on 2011-10-21
1767
    my %opt = @_;
1768
    my $primary_keys = delete $opt{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
1769
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-10-21
1770
    my $where = delete $opt{where};
1771
    my $p = delete $opt{param} || {};
cleanup
Yuki Kimoto authored on 2011-06-08
1772
    $param  ||= $p;
1773
    
1774
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-10-21
1775
    my $where_param = $self->_id_to_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-06-08
1776
    
cleanup
Yuki Kimoto authored on 2011-10-21
1777
    return $self->update(where => $where_param, param => $param, %opt);
cleanup
Yuki Kimoto authored on 2011-06-08
1778
}
1779

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1780
# DEPRECATED!
1781
sub insert_at {
1782
    my $self = shift;
1783
    
cleanup
Yuki Kimoto authored on 2011-10-21
1784
    warn "insert_at is DEPRECATED! use insert method id option instead";
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1785
    
cleanup
Yuki Kimoto authored on 2011-10-21
1786
    # Options
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1787
    my $param;
1788
    $param = shift if @_ % 2;
cleanup
Yuki Kimoto authored on 2011-10-21
1789
    my %opt = @_;
1790
    my $primary_key = delete $opt{primary_key};
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1791
    $primary_key = [$primary_key] unless ref $primary_key;
cleanup
Yuki Kimoto authored on 2011-10-21
1792
    my $where = delete $opt{where};
1793
    my $p = delete $opt{param} || {};
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1794
    $param  ||= $p;
1795
    
1796
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-10-21
1797
    my $where_param = $self->_id_to_param($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1798
    $param = $self->merge_param($where_param, $param);
1799
    
cleanup
Yuki Kimoto authored on 2011-10-21
1800
    return $self->insert(param => $param, %opt);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1801
}
1802

            
added warnings
Yuki Kimoto authored on 2011-06-07
1803
# DEPRECATED!
1804
sub register_tag {
test cleanup
Yuki Kimoto authored on 2011-08-10
1805
    my $self = shift;
1806
    
added warnings
Yuki Kimoto authored on 2011-06-07
1807
    warn "register_tag is DEPRECATED!";
test cleanup
Yuki Kimoto authored on 2011-08-10
1808
    
1809
    # Merge tag
1810
    my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
1811
    $self->{_tags} = {%{$self->{_tags} || {}}, %$tags};
1812
    
1813
    return $self;
1814
}
1815

            
1816
# DEPRECATED!
1817
sub register_tag_processor {
1818
    my $self = shift;
1819
    warn "register_tag_processor is DEPRECATED!";
1820
    # Merge tag
1821
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
1822
    $self->{_tags} = {%{$self->{_tags} || {}}, %{$tag_processors}};
1823
    return $self;
added warnings
Yuki Kimoto authored on 2011-06-07
1824
}
1825

            
cleanup
Yuki Kimoto authored on 2011-01-25
1826
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1827
sub default_bind_filter {
1828
    my $self = shift;
1829
    
cleanup
Yuki Kimoto authored on 2011-06-13
1830
    warn "default_bind_filter is DEPRECATED!";
added warnings
Yuki Kimoto authored on 2011-06-07
1831
    
cleanup
Yuki Kimoto authored on 2011-01-12
1832
    if (@_) {
1833
        my $fname = $_[0];
1834
        
1835
        if (@_ && !$fname) {
1836
            $self->{default_out_filter} = undef;
1837
        }
1838
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1839
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1840
              unless exists $self->filters->{$fname};
1841
        
1842
            $self->{default_out_filter} = $self->filters->{$fname};
1843
        }
1844
        return $self;
1845
    }
1846
    
1847
    return $self->{default_out_filter};
1848
}
1849

            
cleanup
Yuki Kimoto authored on 2011-01-25
1850
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1851
sub default_fetch_filter {
1852
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1853

            
cleanup
Yuki Kimoto authored on 2011-06-13
1854
    warn "default_fetch_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-01-12
1855
    
1856
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1857
        my $fname = $_[0];
1858

            
cleanup
Yuki Kimoto authored on 2011-01-12
1859
        if (@_ && !$fname) {
1860
            $self->{default_in_filter} = undef;
1861
        }
1862
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1863
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1864
              unless exists $self->filters->{$fname};
1865
        
1866
            $self->{default_in_filter} = $self->filters->{$fname};
1867
        }
1868
        
1869
        return $self;
1870
    }
1871
    
many changed
Yuki Kimoto authored on 2011-01-23
1872
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1873
}
1874

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
1875
# DEPRECATED!
1876
sub insert_param {
1877
    my $self = shift;
1878
    warn "insert_param is DEPRECATED! use values_clause instead";
1879
    return $self->values_clause(@_);
1880
}
1881

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1882
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1883
sub insert_param_tag {
1884
    warn "insert_param_tag is DEPRECATED! " .
1885
         "use insert_param instead!";
1886
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1887
}
1888

            
1889
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1890
sub update_param_tag {
fixed DEPRECATED message bug
Yuki Kimoto authored on 2011-06-10
1891
    warn "update_param_tag is DEPRECATED! " .
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1892
         "use update_param instead";
1893
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1894
}
cleanup
Yuki Kimoto authored on 2011-03-08
1895
# DEPRECATED!
1896
sub _push_relation {
1897
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1898
    
1899
    if (keys %{$relation || {}}) {
micro optimization
Yuki Kimoto authored on 2011-09-30
1900
        $$sql .= $need_where ? 'where ' : 'and ';
cleanup
Yuki Kimoto authored on 2011-10-21
1901
        for my $rcolumn (keys %$relation) {
cleanup
Yuki Kimoto authored on 2011-03-08
1902
            my $table1 = (split (/\./, $rcolumn))[0];
1903
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1904
            push @$tables, ($table1, $table2);
micro optimization
Yuki Kimoto authored on 2011-09-30
1905
            $$sql .= "$rcolumn = " . $relation->{$rcolumn} .  'and ';
cleanup
Yuki Kimoto authored on 2011-03-08
1906
        }
1907
    }
micro optimization
Yuki Kimoto authored on 2011-09-30
1908
    $$sql =~ s/and $/ /;
cleanup
Yuki Kimoto authored on 2011-03-08
1909
}
1910

            
1911
# DEPRECATED!
1912
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1913
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1914
    
1915
    if (keys %{$relation || {}}) {
cleanup
Yuki Kimoto authored on 2011-10-21
1916
        for my $rcolumn (keys %$relation) {
cleanup
Yuki Kimoto authored on 2011-03-08
1917
            my $table1 = (split (/\./, $rcolumn))[0];
1918
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1919
            my $table1_exists;
1920
            my $table2_exists;
cleanup
Yuki Kimoto authored on 2011-10-21
1921
            for my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-03-08
1922
                $table1_exists = 1 if $table eq $table1;
1923
                $table2_exists = 1 if $table eq $table2;
1924
            }
1925
            unshift @$tables, $table1 unless $table1_exists;
1926
            unshift @$tables, $table2 unless $table2_exists;
1927
        }
1928
    }
1929
}
1930

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1933
=head1 NAME
1934

            
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
1935
DBIx::Custom - DBI extension to execute insert, update, delete, and select easily
removed reconnect method
yuki-kimoto authored on 2010-05-28
1936

            
fix heading typos
Terrence Brannon authored on 2011-08-17
1937
=head1 SYNOPSIS
cleanup
yuki-kimoto authored on 2010-08-05
1938

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1939
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1940
    
1941
    # Connect
1942
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1943
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1944
        user => 'ken',
1945
        password => '!LFKD%$&',
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
1946
        option => {mysql_enable_utf8 => 1}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1947
    );
cleanup
yuki-kimoto authored on 2010-08-05
1948

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1949
    # Insert 
updated pod
Yuki Kimoto authored on 2011-06-21
1950
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
removed reconnect method
yuki-kimoto authored on 2010-05-28
1951
    
1952
    # Update 
updated pod
Yuki Kimoto authored on 2011-06-21
1953
    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1954
      where  => {id => 5});
removed reconnect method
yuki-kimoto authored on 2010-05-28
1955
    
1956
    # Delete
updated pod
Yuki Kimoto authored on 2011-06-21
1957
    $dbi->delete(table  => 'book', where => {author => 'Ken'});
cleanup
yuki-kimoto authored on 2010-08-05
1958

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1959
    # Select
updated pod
Yuki Kimoto authored on 2011-06-21
1960
    my $result = $dbi->select(table  => 'book',
1961
      column => ['title', 'author'], where  => {author => 'Ken'});
cleanup
yuki-kimoto authored on 2010-08-05
1962

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1963
    # Select, more complex
1964
    my $result = $dbi->select(
1965
        table  => 'book',
1966
        column => [
cleanup
Yuki Kimoto authored on 2011-06-13
1967
            {book => [qw/title author/]},
1968
            {company => ['name']}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1969
        ],
1970
        where  => {'book.author' => 'Ken'},
1971
        join => ['left outer join company on book.company_id = company.id'],
1972
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1973
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1974
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1975
    # Fetch
1976
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1977
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1978
    }
1979
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1980
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1981
    while (my $row = $result->fetch_hash) {
1982
        
1983
    }
1984
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1985
    # Execute SQL with parameter.
1986
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1987
        "select id from book where author = :author and title like :title",
updated pod
Yuki Kimoto authored on 2011-06-21
1988
        {author => 'ken', title => '%Perl%'}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1989
    );
1990
    
fix heading typos
Terrence Brannon authored on 2011-08-17
1991
=head1 DESCRIPTION
removed reconnect method
yuki-kimoto authored on 2010-05-28
1992

            
cleanup
Yuki Kimoto authored on 2011-07-29
1993
L<DBIx::Custom> is L<DBI> wrapper module to execute SQL easily.
updated pod
Yuki Kimoto authored on 2011-06-21
1994
This module have the following features.
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1995

            
updated pod
Yuki Kimoto authored on 2011-06-21
1996
=over 4
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1997

            
cleanup
Yuki Kimoto authored on 2011-07-29
1998
=item *
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1999

            
cleanup
Yuki Kimoto authored on 2011-07-29
2000
Execute C<insert>, C<update>, C<delete>, or C<select> statement easily
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2001

            
cleanup
Yuki Kimoto authored on 2011-07-29
2002
=item *
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2003

            
cleanup
Yuki Kimoto authored on 2011-07-29
2004
Create C<where> clause flexibly
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2005

            
cleanup
Yuki Kimoto authored on 2011-07-29
2006
=item *
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2007

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2008
Named place holder support
2009

            
2010
=item *
2011

            
cleanup
Yuki Kimoto authored on 2011-07-29
2012
Model support
2013

            
2014
=item *
2015

            
2016
Connection manager support
2017

            
2018
=item *
pod fix
Yuki Kimoto authored on 2011-01-21
2019

            
cleanup
Yuki Kimoto authored on 2011-07-30
2020
Choice your favorite relational database management system,
cleanup
Yuki Kimoto authored on 2011-07-29
2021
C<MySQL>, C<SQLite>, C<PostgreSQL>, C<Oracle>,
2022
C<Microsoft SQL Server>, C<Microsoft Access>, C<DB2> or anything, 
2023

            
2024
=item *
2025

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2026
Filtering by data type or column name
cleanup
Yuki Kimoto authored on 2011-07-29
2027

            
2028
=item *
2029

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2030
Create C<order by> clause flexibly
cleanup
Yuki Kimoto authored on 2011-07-29
2031

            
2032
=back
pod fix
Yuki Kimoto authored on 2011-01-21
2033

            
fix heading typos
Terrence Brannon authored on 2011-08-17
2034
=head1 DOCUMENTATION
pod fix
Yuki Kimoto authored on 2011-01-21
2035

            
cleanup
Yuki Kimoto authored on 2011-07-29
2036
L<DBIx::Custom::Guide> - How to use L<DBIx::Custom>
pod fix
Yuki Kimoto authored on 2011-01-21
2037

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2038
L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki>
cleanup
Yuki Kimoto authored on 2011-07-29
2039
- Theare are various examples.
2040

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2041
Module documentations - 
cleanup
Yuki Kimoto authored on 2011-07-29
2042
L<DBIx::Custom::Result>,
2043
L<DBIx::Custom::Query>,
2044
L<DBIx::Custom::Where>,
2045
L<DBIx::Custom::Model>,
2046
L<DBIx::Custom::Order>
updated document
yuki-kimoto authored on 2010-08-08
2047

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

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

            
2052
    my $connector = $dbi->connector;
micro optimization
Yuki Kimoto authored on 2011-07-30
2053
    $dbi = $dbi->connector($connector);
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2054

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2055
Connection manager object. if C<connector> is set, you can get C<dbh>
2056
through connection manager. Conection manager object must have C<dbh> mehtod.
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2057

            
2058
This is L<DBIx::Connector> example. Please pass
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2059
C<default_option> to L<DBIx::Connector> C<new> method.
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2060

            
2061
    my $connector = DBIx::Connector->new(
cleanup
Yuki Kimoto authored on 2011-08-16
2062
        "dbi:mysql:database=$database",
2063
        $user,
2064
        $password,
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2065
        DBIx::Custom->new->default_option
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2066
    );
2067
    
updated pod
Yuki Kimoto authored on 2011-06-21
2068
    my $dbi = DBIx::Custom->connect(connector => $connector);
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2069

            
cleanup
Yuki Kimoto authored on 2011-08-16
2070
If C<connector> is set to 1 when connect method is called,
2071
L<DBIx::Connector> is automatically set to C<connector>
2072

            
2073
    my $dbi = DBIx::Custom->connect(
2074
      dsn => $dsn, user => $user, password => $password, connector => 1);
2075
    
2076
    my $connector = $dbi->connector; # DBIx::Connector
2077

            
2078
Note that L<DBIx::Connector> must be installed.
2079

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

            
2082
    my $dsn = $dbi->dsn;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2083
    $dbi = $dbi->dsn("DBI:mysql:database=dbname");
packaging one directory
yuki-kimoto authored on 2009-11-16
2084

            
updated pod
Yuki Kimoto authored on 2011-06-21
2085
Data source name, used when C<connect> method is executed.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
2086

            
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2087
=head2 C<default_option>
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
2088

            
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2089
    my $default_option = $dbi->default_option;
2090
    $dbi = $dbi->default_option($default_option);
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
2091

            
updated pod
Yuki Kimoto authored on 2011-06-21
2092
L<DBI> default option, used when C<connect> method is executed,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2093
default to the following values.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
2094

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2095
    {
2096
        RaiseError => 1,
2097
        PrintError => 0,
2098
        AutoCommit => 1,
2099
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
2100

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
2101
=head2 C<exclude_table>
2102

            
2103
    my $exclude_table = $dbi->exclude_table;
2104
    $dbi = $dbi->exclude_table(qr/pg_/);
2105

            
2106
Excluded table regex.
2107
C<each_column>, C<each_table>, C<type_rule>,
2108
and C<setup_model> methods ignore matching tables.
2109

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2112
    my $filters = $dbi->filters;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2113
    $dbi = $dbi->filters(\%filters);
packaging one directory
yuki-kimoto authored on 2009-11-16
2114

            
updated pod
Yuki Kimoto authored on 2011-06-21
2115
Filters, registered by C<register_filter> method.
add models() attribute
Yuki Kimoto authored on 2011-02-21
2116

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
2117
=head2 C<last_sql>
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
2118

            
2119
    my $last_sql = $dbi->last_sql;
2120
    $dbi = $dbi->last_sql($last_sql);
2121

            
2122
Get last successed SQL executed by C<execute> method.
2123

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

            
2126
    my $models = $dbi->models;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2127
    $dbi = $dbi->models(\%models);
add models() attribute
Yuki Kimoto authored on 2011-02-21
2128

            
updated pod
Yuki Kimoto authored on 2011-06-21
2129
Models, included by C<include_model> method.
add models() attribute
Yuki Kimoto authored on 2011-02-21
2130

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
2131
=head2 C<option>
2132

            
2133
    my $option = $dbi->option;
2134
    $dbi = $dbi->option($option);
2135

            
2136
L<DBI> option, used when C<connect> method is executed.
2137
Each value in option override the value of C<default_option>.
2138

            
cleanup
yuki-kimoto authored on 2010-10-17
2139
=head2 C<password>
2140

            
2141
    my $password = $dbi->password;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2142
    $dbi = $dbi->password('lkj&le`@s');
cleanup
yuki-kimoto authored on 2010-10-17
2143

            
updated pod
Yuki Kimoto authored on 2011-06-21
2144
Password, used when C<connect> method is executed.
update document
yuki-kimoto authored on 2010-01-30
2145

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

            
test cleanup
Yuki Kimoto authored on 2011-08-10
2148
    my $builder = $dbi->query_builder;
added commit method
yuki-kimoto authored on 2010-05-27
2149

            
test cleanup
Yuki Kimoto authored on 2011-08-10
2150
Creat query builder. This is L<DBIx::Custom::QueryBuilder>.
cleanup
yuki-kimoto authored on 2010-08-05
2151

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2152
=head2 C<quote>
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
2153

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2154
     my quote = $dbi->quote;
2155
     $dbi = $dbi->quote('"');
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
2156

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
2157
Reserved word quote.
2158
Default to double quote '"' except for mysql.
2159
In mysql, default to back quote '`'
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
2160

            
cleanup
Yuki Kimoto authored on 2011-07-30
2161
You can set quote pair.
2162

            
2163
    $dbi->quote('[]');
2164

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2167
    my $result_class = $dbi->result_class;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2168
    $dbi = $dbi->result_class('DBIx::Custom::Result');
cleanup
yuki-kimoto authored on 2010-08-05
2169

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

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

            
fixed pod
Yuki Kimoto authored on 2011-09-27
2174
    my $safety_character = $dbi->safety_character;
2175
    $dbi = $dbi->safety_character($character);
update pod
Yuki Kimoto authored on 2011-01-27
2176

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

            
cleanup test
Yuki Kimoto authored on 2011-08-10
2180
=head2 C<separator>
2181

            
fixed pod
Yuki Kimoto authored on 2011-09-27
2182
    my $separator = $dbi->separator;
2183
    $dbi = $dbi->separator('-');
improved join clause parsing
Yuki Kimoto authored on 2011-09-27
2184

            
2185
Separator which join table name and column name.
2186
This have effect to C<column> and C<mycolumn> method,
2187
and C<select> method's column option.
cleanup test
Yuki Kimoto authored on 2011-08-10
2188

            
improved join clause parsing
Yuki Kimoto authored on 2011-09-27
2189
Default to C<.>.
cleanup test
Yuki Kimoto authored on 2011-08-10
2190

            
added tag_parse attribute
Yuki Kimoto authored on 2011-06-28
2191
=head2 C<tag_parse>
2192

            
2193
    my $tag_parse = $dbi->tag_parse(0);
2194
    $dbi = $dbi->tag_parse;
2195

            
2196
Enable DEPRECATED tag parsing functionality, default to 1.
2197
If you want to disable tag parsing functionality, set to 0.
2198

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2201
    my $user = $dbi->user;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
2202
    $dbi = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
2203

            
updated pod
Yuki Kimoto authored on 2011-06-21
2204
User name, used when C<connect> method is executed.
update pod
Yuki Kimoto authored on 2011-01-27
2205

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2206
=head2 C<user_column_info>
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2207

            
2208
    my $user_column_info = $dbi->user_column_info;
2209
    $dbi = $dbi->user_column_info($user_column_info);
2210

            
improved join clause parsing
Yuki Kimoto authored on 2011-09-30
2211
You can set the date like the following one.
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2212

            
2213
    [
2214
        {table => 'book', column => 'title', info => {...}},
2215
        {table => 'author', column => 'name', info => {...}}
2216
    ]
2217

            
improved join clause parsing
Yuki Kimoto authored on 2011-09-30
2218
Usually, you set return value of C<get_column_info>.
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2219

            
2220
    my $user_column_info
2221
      = $dbi->get_column_info(exclude_table => qr/^system/);
2222
    $dbi->user_column_info($user_column_info);
2223

            
2224
If C<user_column_info> is set, C<each_column> use C<user_column_info>
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2225
to find column info. this is very fast.
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2226

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2227
=head2 C<user_table_info>
added test
Yuki Kimoto authored on 2011-08-16
2228

            
2229
    my $user_table_info = $dbi->user_table_info;
2230
    $dbi = $dbi->user_table_info($user_table_info);
2231

            
2232
You can set the following data.
2233

            
2234
    [
2235
        {table => 'book', info => {...}},
2236
        {table => 'author', info => {...}}
2237
    ]
2238

            
2239
Usually, you can set return value of C<get_table_info>.
2240

            
2241
    my $user_table_info = $dbi->get_table_info(exclude => qr/^system/);
2242
    $dbi->user_table_info($user_table_info);
2243

            
2244
If C<user_table_info> is set, C<each_table> use C<user_table_info>
2245
to find table info.
2246

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

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

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2253
=head2 C<available_datatype>
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2254

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
2255
    print $dbi->available_datatype;
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2256

            
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
2257
Get available data types. You can use these data types
updated pod
Yuki Kimoto authored on 2011-06-21
2258
in C<type rule>'s C<from1> and C<from2> section.
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
2259

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2260
=head2 C<available_typename>
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
2261

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
2262
    print $dbi->available_typename;
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
2263

            
2264
Get available type names. You can use these type names in
updated pod
Yuki Kimoto authored on 2011-06-21
2265
C<type_rule>'s C<into1> and C<into2> section.
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2266

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
2267
=head2 C<assign_clause>
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
2268

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
2269
    my $assign_clause = $dbi->assign_clause({title => 'a', age => 2});
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
2270

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
2271
Create assign clause
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
2272

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

            
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
2275
This is used to create update clause.
2276

            
2277
    "update book set " . $dbi->assign_clause({title => 'a', age => 2});
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
2278

            
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2279
=head2 C<column>
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2280

            
cleanup
Yuki Kimoto authored on 2011-06-13
2281
    my $column = $dbi->column(book => ['author', 'title']);
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2282

            
2283
Create column clause. The follwoing column clause is created.
2284

            
2285
    book.author as "book.author",
2286
    book.title as "book.title"
2287

            
cleanup test
Yuki Kimoto authored on 2011-08-10
2288
You can change separator by C<separator> attribute.
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2289

            
cleanup
Yuki Kimoto authored on 2011-06-13
2290
    # Separator is hyphen
2291
    $dbi->separator('-');
2292
    
2293
    book.author as "book-author",
2294
    book.title as "book-title"
2295
    
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2296
=head2 C<connect>
packaging one directory
yuki-kimoto authored on 2009-11-16
2297

            
update pod
Yuki Kimoto authored on 2011-03-13
2298
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2299
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2300
        user => 'ken',
2301
        password => '!LFKD%$&',
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2302
        option => {mysql_enable_utf8 => 1}
update pod
Yuki Kimoto authored on 2011-03-13
2303
    );
2304

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

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

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2311
=head2 C<count>
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
2312

            
fixed id option bug when col...
Yuki Kimoto authored on 2011-10-10
2313
    my $count = $dbi->count(table => 'book');
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
2314

            
2315
Get rows count.
2316

            
2317
Options is same as C<select> method's ones.
2318

            
2319
=head2 C<create_model>
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2320

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
2321
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2322
        table => 'book',
2323
        primary_key => 'id',
2324
        join => [
2325
            'inner join company on book.comparny_id = company.id'
2326
        ],
2327
    );
2328

            
2329
Create L<DBIx::Custom::Model> object and initialize model.
updated pod
Yuki Kimoto authored on 2011-06-21
2330
the module is also used from C<model> method.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2331

            
2332
   $dbi->model('book')->select(...);
2333

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

            
2336
    my $dbh = $dbi->dbh;
2337

            
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2338
Get L<DBI> database handle. if C<connector> is set, you can get
updated pod
Yuki Kimoto authored on 2011-06-21
2339
database handle through C<connector> object.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2340

            
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
2341
=head2 C<delete>
2342

            
2343
    $dbi->delete(table => 'book', where => {title => 'Perl'});
2344

            
2345
Execute delete statement.
2346

            
2347
The following opitons are available.
2348

            
cleanup
Yuki Kimoto authored on 2011-10-20
2349
B<OPTIONS>
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
2350

            
cleanup
Yuki Kimoto authored on 2011-10-20
2351
C<delete> method use all of C<execute> method's options,
2352
and use the following new ones.
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
2353

            
cleanup
Yuki Kimoto authored on 2011-10-20
2354
=over 4
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
2355

            
2356
=item C<id>
2357

            
2358
    id => 4
2359
    id => [4, 5]
2360

            
2361
ID corresponding to C<primary_key>.
2362
You can delete rows by C<id> and C<primary_key>.
2363

            
2364
    $dbi->delete(
fixed pod
Yuki Kimoto authored on 2011-10-20
2365
        primary_key => ['id1', 'id2'],
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
2366
        id => [4, 5],
2367
        table => 'book',
2368
    );
2369

            
2370
The above is same as the followin one.
2371

            
2372
    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
2373

            
2374
=item C<prefix>
2375

            
2376
    prefix => 'some'
2377

            
2378
prefix before table name section.
2379

            
2380
    delete some from book
2381

            
2382
=item C<table>
2383

            
2384
    table => 'book'
2385

            
2386
Table name.
2387

            
2388
=item C<where>
2389

            
2390
Same as C<select> method's C<where> option.
2391

            
2392
=back
2393

            
2394
=head2 C<delete_all>
2395

            
2396
    $dbi->delete_all(table => $table);
2397

            
2398
Execute delete statement for all rows.
2399
Options is same as C<delete>.
2400

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2401
=head2 C<each_column>
2402

            
2403
    $dbi->each_column(
2404
        sub {
2405
            my ($dbi, $table, $column, $column_info) = @_;
2406
            
2407
            my $type = $column_info->{TYPE_NAME};
2408
            
2409
            if ($type eq 'DATE') {
2410
                # ...
2411
            }
2412
        }
2413
    );
2414

            
improved pod
Yuki Kimoto authored on 2011-10-14
2415
Iterate all column informations in database.
2416
Argument is callback which is executed when one column is found.
2417
Callback receive four arguments. C<DBIx::Custom object>, C<table name>,
2418
C<column name>, and C<column information>.
2419

            
2420
If C<user_column_info> is set, C<each_column> method use C<user_column_info>
2421
infromation, you can improve the performance of C<each_column> in
2422
the following way.
2423

            
2424
    my $column_infos = $dbi->get_column_info(exclude_table => qr/^system_/);
2425
    $dbi->user_column_info($column_info);
2426
    $dbi->each_column(sub { ... });
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
2427

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
2428
=head2 C<each_table>
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
2429

            
2430
    $dbi->each_table(
2431
        sub {
2432
            my ($dbi, $table, $table_info) = @_;
2433
            
2434
            my $table_name = $table_info->{TABLE_NAME};
2435
        }
2436
    );
2437

            
improved pod
Yuki Kimoto authored on 2011-10-14
2438
Iterate all table informationsfrom in database.
2439
Argument is callback which is executed when one table is found.
2440
Callback receive three arguments, C<DBIx::Custom object>, C<table name>,
2441
C<table information>.
2442

            
2443
If C<user_table_info> is set, C<each_table> method use C<user_table_info>
2444
infromation, you can improve the performance of C<each_table> in
2445
the following way.
2446

            
2447
    my $table_infos = $dbi->get_table_info(exclude => qr/^system_/);
2448
    $dbi->user_table_info($table_info);
2449
    $dbi->each_table(sub { ... });
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
2450

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2453
    my $result = $dbi->execute(
updated pod
Yuki Kimoto authored on 2011-06-21
2454
      "select * from book where title = :title and author like :author",
2455
      {title => 'Perl', author => '%Ken%'}
2456
    );
2457

            
2458
    my $result = $dbi->execute(
2459
      "select * from book where title = :book.title and author like :book.author",
2460
      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
update pod
Yuki Kimoto authored on 2011-03-13
2461
    );
2462

            
updated pod
Yuki Kimoto authored on 2011-06-21
2463
Execute SQL. SQL can contain column parameter such as :author and :title.
2464
You can append table name to column name such as :book.title and :book.author.
2465
Second argunet is data, embedded into column parameter.
2466
Return value is L<DBIx::Custom::Result> object when select statement is executed,
2467
or the count of affected rows when insert, update, delete statement is executed.
update pod
Yuki Kimoto authored on 2011-03-13
2468

            
I call :title named placehol...
Yuki Kimoto authored on 2011-07-30
2469
Named placeholder such as C<:title> is replaced by placeholder C<?>.
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2470
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2471
    # Original
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2472
    select * from book where title = :title and author like :author
2473
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2474
    # Replaced
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2475
    select * from where title = ? and author like ?;
update pod
Yuki Kimoto authored on 2011-03-13
2476

            
I call :title named placehol...
Yuki Kimoto authored on 2011-07-30
2477
You can specify operator with named placeholder
fixed pod
Yuki Kimoto authored on 2011-10-20
2478
by C<name{operator}> syntax.
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2479

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2480
    # Original
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2481
    select * from book where :title{=} and :author{like}
2482
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2483
    # Replaced
update pod
Yuki Kimoto authored on 2011-03-13
2484
    select * from where title = ? and author like ?;
2485

            
fixed named placeholder bug ...
Yuki Kimoto authored on 2011-08-01
2486
Note that colons in time format such as 12:13:15 is exeption,
2487
it is not parsed as named placeholder.
2488
If you want to use colon generally, you must escape it by C<\\>
2489

            
2490
    select * from where title = "aa\\:bb";
2491

            
cleanup
Yuki Kimoto authored on 2011-10-20
2492
B<OPTIONS>
2493

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

            
2496
=over 4
2497

            
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2498
=item C<after_build_sql> 
2499

            
2500
You can filter sql after the sql is build.
2501

            
2502
    after_build_sql => $code_ref
2503

            
2504
The following one is one example.
2505

            
2506
    $dbi->select(
2507
        table => 'book',
2508
        column => 'distinct(name)',
2509
        after_build_sql => sub {
2510
            "select count(*) from ($_[0]) as t1"
2511
        }
2512
    );
2513

            
2514
The following SQL is executed.
2515

            
2516
    select count(*) from (select distinct(name) from book) as t1;
2517

            
cleanup
Yuki Kimoto authored on 2011-10-20
2518
=item C<append>
2519

            
2520
    append => 'order by name'
2521

            
2522
Append some statement after SQL.
2523

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
2524
=item C<bind_type>
2525

            
2526
Specify database bind data type.
2527

            
2528
    bind_type => [image => DBI::SQL_BLOB]
2529
    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2530

            
2531
This is used to bind parameter by C<bind_param> of statment handle.
2532

            
2533
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2534

            
update pod
Yuki Kimoto authored on 2011-03-13
2535
=item C<filter>
updated pod
Yuki Kimoto authored on 2011-06-09
2536
    
2537
    filter => {
2538
        title  => sub { uc $_[0] }
2539
        author => sub { uc $_[0] }
2540
    }
update pod
Yuki Kimoto authored on 2011-03-13
2541

            
updated pod
Yuki Kimoto authored on 2011-06-09
2542
    # Filter name
2543
    filter => {
2544
        title  => 'upper_case',
2545
        author => 'upper_case'
2546
    }
2547
        
2548
    # At once
2549
    filter => [
2550
        [qw/title author/]  => sub { uc $_[0] }
2551
    ]
2552

            
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2553
Filter. You can set subroutine or filter name
updated pod
Yuki Kimoto authored on 2011-06-21
2554
registered by by C<register_filter>.
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2555
This filter is executed before data is saved into database.
2556
and before type rule filter is executed.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2557

            
- removed placeholder count ...
Yuki Kimoto authored on 2011-08-22
2558
=item C<id>
2559

            
2560
    id => 4
2561
    id => [4, 5]
2562

            
2563
ID corresponding to C<primary_key>.
2564
You can delete rows by C<id> and C<primary_key>.
2565

            
2566
    $dbi->execute(
2567
        "select * from book where id1 = :id1 and id2 = :id2",
2568
        {},
fixed pod
Yuki Kimoto authored on 2011-10-20
2569
        primary_key => ['id1', 'id2'],
- removed placeholder count ...
Yuki Kimoto authored on 2011-08-22
2570
        id => [4, 5],
2571
    );
2572

            
2573
The above is same as the followin one.
2574

            
2575
    $dbi->execute(
2576
        "select * from book where id1 = :id1 and id2 = :id2",
2577
        {id1 => 4, id2 => 5}
2578
    );
2579

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

            
2582
    query => 1
2583

            
2584
C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
cleanup
Yuki Kimoto authored on 2011-07-30
2585
You can check SQL or get statment handle.
updated pod
Yuki Kimoto authored on 2011-06-21
2586

            
2587
    my $sql = $query->sql;
cleanup
Yuki Kimoto authored on 2011-07-30
2588
    my $sth = $query->sth;
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2589
    my $columns = $query->columns;
2590
    
2591
If you want to execute SQL fast, you can do the following way.
2592

            
2593
    my $query;
cleanup
Yuki Kimoto authored on 2011-10-21
2594
    for my $row (@$rows) {
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2595
      $query ||= $dbi->insert($row, table => 'table1', query => 1);
cleanup
Yuki Kimoto authored on 2011-10-20
2596
      $dbi->execute($query, $row);
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2597
    }
2598

            
2599
Statement handle is reused and SQL parsing is finished,
2600
so you can get more performance than normal way.
cleanup
Yuki Kimoto authored on 2011-07-30
2601

            
2602
If you want to execute SQL as possible as fast and don't need filtering.
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2603
You can do the following way.
cleanup
Yuki Kimoto authored on 2011-07-30
2604
    
2605
    my $query;
2606
    my $sth;
cleanup
Yuki Kimoto authored on 2011-10-21
2607
    for my $row (@$rows) {
cleanup
Yuki Kimoto authored on 2011-07-30
2608
      $query ||= $dbi->insert($row, table => 'book', query => 1);
2609
      $sth ||= $query->sth;
2610
      $sth->execute(map { $row->{$_} } sort keys %$row);
2611
    }
2612

            
2613
Note that $row must be simple hash reference, such as
2614
{title => 'Perl', author => 'Ken'}.
2615
and don't forget to sort $row values by $row key asc order.
updated document
Yuki Kimoto authored on 2011-06-09
2616

            
- removed placeholder count ...
Yuki Kimoto authored on 2011-08-22
2617
=item C<primary_key>
2618

            
cleanup
Yuki Kimoto authored on 2011-10-20
2619
    primary_key => 'id'
2620
    primary_key => ['id1', 'id2']
2621

            
2622
Priamry key. This is used when C<id> option find primary key.
- removed placeholder count ...
Yuki Kimoto authored on 2011-08-22
2623

            
updated pod
Yuki Kimoto authored on 2011-06-09
2624
=item C<table>
2625
    
2626
    table => 'author'
2627

            
updated pod
Yuki Kimoto authored on 2011-06-21
2628
If you want to omit table name in column name
2629
and enable C<into1> and C<into2> type filter,
2630
You must set C<table> option.
updated pod
Yuki Kimoto authored on 2011-06-09
2631

            
updated pod
Yuki Kimoto authored on 2011-06-21
2632
    $dbi->execute("select * from book where title = :title and author = :author",
2633
        {title => 'Perl', author => 'Ken', table => 'book');
updated pod
Yuki Kimoto authored on 2011-06-09
2634

            
updated pod
Yuki Kimoto authored on 2011-06-21
2635
    # Same
2636
    $dbi->execute(
2637
      "select * from book where title = :book.title and author = :book.author",
2638
      {title => 'Perl', author => 'Ken');
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2639

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2640
=item C<table_alias>
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
2641

            
cleanup
Yuki Kimoto authored on 2011-10-20
2642
    table_alias => {user => 'worker'}
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
2643

            
2644
Table alias. Key is real table name, value is alias table name.
2645
If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2646
on alias table name.
2647

            
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
2648
=item C<reuse EXPERIMENTAL>
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2649
    
micro optimization
Yuki Kimoto authored on 2011-10-23
2650
    reuse => $has_ref
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2651

            
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
2652
Reuse query object if the hash reference variable is set.
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2653
    
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
2654
    my $queries = {};
2655
    $dbi->execute($sql, $param, reuse => $queries);
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2656

            
added EXPERIMENTAL reuse_que...
Yuki Kimoto authored on 2011-10-22
2657
This will improved performance when you want to execute same query repeatedly
2658
because generally creating query object is slow.
added EXPERIMENTAL reuse_sth...
Yuki Kimoto authored on 2011-10-22
2659

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2660
=item C<type_rule_off>
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2661

            
2662
    type_rule_off => 1
2663

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2664
Turn C<into1> and C<into2> type rule off.
2665

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2666
=item C<type_rule1_off>
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2667

            
2668
    type_rule1_off => 1
2669

            
2670
Turn C<into1> type rule off.
2671

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2672
=item C<type_rule2_off>
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2673

            
2674
    type_rule2_off => 1
2675

            
2676
Turn C<into2> type rule off.
update document
yuki-kimoto authored on 2009-11-19
2677

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

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2680
=head2 C<get_column_info>
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2681

            
improved pod
Yuki Kimoto authored on 2011-10-14
2682
    my $column_infos = $dbi->get_column_info(exclude_table => qr/^system_/);
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2683

            
2684
get column infomation except for one which match C<exclude_table> pattern.
2685

            
2686
    [
2687
        {table => 'book', column => 'title', info => {...}},
2688
        {table => 'author', column => 'name' info => {...}}
2689
    ]
2690

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2691
=head2 C<get_table_info>
added test
Yuki Kimoto authored on 2011-08-16
2692

            
improved pod
Yuki Kimoto authored on 2011-10-14
2693
    my $table_infos = $dbi->get_table_info(exclude => qr/^system_/);
update pod
Yuki Kimoto authored on 2011-03-13
2694

            
added test
Yuki Kimoto authored on 2011-08-16
2695
get table infomation except for one which match C<exclude> pattern.
2696

            
2697
    [
2698
        {table => 'book', info => {...}},
2699
        {table => 'author', info => {...}}
2700
    ]
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2701

            
added test
Yuki Kimoto authored on 2011-08-16
2702
You can set this value to C<user_table_info>.
update pod
Yuki Kimoto authored on 2011-03-13
2703

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
2704
=head2 C<helper>
2705

            
2706
    $dbi->helper(
2707
        update_or_insert => sub {
2708
            my $self = shift;
2709
            
2710
            # Process
2711
        },
2712
        find_or_create   => sub {
2713
            my $self = shift;
2714
            
2715
            # Process
2716
        }
2717
    );
2718

            
2719
Register helper. These helper is called directly from L<DBIx::Custom> object.
2720

            
2721
    $dbi->update_or_insert;
2722
    $dbi->find_or_create;
2723

            
cleanup
yuki-kimoto authored on 2010-10-17
2724
=head2 C<insert>
2725

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2728
Execute insert statement. First argument is row data. Return value is
2729
affected row count.
update pod
Yuki Kimoto authored on 2011-03-13
2730

            
insert and update method's p...
Yuki Kimoto authored on 2011-07-29
2731
If you want to set constant value to row data, use scalar reference
2732
as parameter value.
2733

            
2734
    {date => \"NOW()"}
2735

            
cleanup
Yuki Kimoto authored on 2011-10-20
2736
B<options>
2737

            
cleanup
Yuki Kimoto authored on 2011-10-20
2738
C<insert> method use all of C<execute> method's options,
cleanup
Yuki Kimoto authored on 2011-10-20
2739
and use the following new ones.
update pod
Yuki Kimoto authored on 2011-03-13
2740

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

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2743
=item C<id>
2744

            
updated document
Yuki Kimoto authored on 2011-06-09
2745
    id => 4
2746
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2747

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2751
    $dbi->insert(
updated document
Yuki Kimoto authored on 2011-06-09
2752
        {title => 'Perl', author => 'Ken'}
fixed pod
Yuki Kimoto authored on 2011-10-20
2753
        primary_key => ['id1', 'id2'],
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2754
        id => [4, 5],
updated document
Yuki Kimoto authored on 2011-06-09
2755
        table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2756
    );
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2757

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

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

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
2765
=item C<prefix>
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
2766

            
2767
    prefix => 'or replace'
2768

            
2769
prefix before table name section
2770

            
2771
    insert or replace into book
2772

            
updated document
Yuki Kimoto authored on 2011-06-09
2773
=item C<table>
2774

            
2775
    table => 'book'
2776

            
2777
Table name.
2778

            
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
2779
=item C<timestamp>
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
2780

            
2781
    timestamp => 1
2782

            
2783
If this value is set to 1,
2784
automatically created timestamp column is set based on
2785
C<timestamp> attribute's C<insert> value.
2786

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2787
=item C<wrap>
updated pod
Yuki Kimoto authored on 2011-09-02
2788

            
2789
    wrap => {price => sub { "max($_[0])" }}
2790

            
2791
placeholder wrapped string.
2792

            
2793
If the following statement
2794

            
2795
    $dbi->insert({price => 100}, table => 'book',
2796
      {price => sub { "$_[0] + 5" }});
2797

            
2798
is executed, the following SQL is executed.
2799

            
2800
    insert into book price values ( ? + 5 );
2801

            
update pod
Yuki Kimoto authored on 2011-03-13
2802
=back
2803

            
2804
=over 4
2805

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2813
    lib / MyModel.pm
2814
        / MyModel / book.pm
2815
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2816

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

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

            
2821
    package MyModel;
updated pod
Yuki Kimoto authored on 2011-06-21
2822
    use DBIx::Custom::Model -base;
update pod
Yuki Kimoto authored on 2011-03-13
2823
    
2824
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2825

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2830
    package MyModel::book;
updated pod
Yuki Kimoto authored on 2011-06-21
2831
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2832
    
2833
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2834

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2837
    package MyModel::company;
updated pod
Yuki Kimoto authored on 2011-06-21
2838
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2839
    
2840
    1;
2841
    
updated pod
Yuki Kimoto authored on 2011-06-21
2842
MyModel::book and MyModel::company is included by C<include_model>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2843

            
updated pod
Yuki Kimoto authored on 2011-06-21
2844
You can get model object by C<model>.
update pod
Yuki Kimoto authored on 2011-03-13
2845

            
updated pod
Yuki Kimoto authored on 2011-06-21
2846
    my $book_model = $dbi->model('book');
update pod
Yuki Kimoto authored on 2011-03-13
2847
    my $company_model = $dbi->model('company');
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2848

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

            
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
2851
=head2 C<insert_timestamp>
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
2852

            
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
2853
    $dbi->insert_timestamp(
2854
      [qw/created_at updated_at/]
2855
        => sub { Time::Piece->localtime->strftime("%Y-%m-%d %H:%M:%S") }
2856
    );
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
2857

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
2858
Timestamp value when C<insert> method is executed
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
2859
with C<timestamp> option.
2860

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
2861
If C<insert_timestamp> is set and C<insert> method is executed
2862
with C<timestamp> option, column C<created_at> and C<update_at>
2863
is automatically set to the value like "2010-10-11 10:12:54".
2864

            
moved DBIx::Custom::Guide to...
Yuki Kimoto authored on 2011-10-22
2865
    $dbi->insert($param, table => 'book', timestamp => 1);
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
2866

            
cleanup
Yuki Kimoto authored on 2011-10-20
2867
=head2 C<like_value>
added EXPERIMENTAL like_valu...
Yuki Kimoto authored on 2011-09-16
2868

            
2869
    my $like_value = $dbi->like_value
2870

            
cleanup
Yuki Kimoto authored on 2011-10-20
2871
Code reference which return a value for the like value.
added EXPERIMENTAL like_valu...
Yuki Kimoto authored on 2011-09-16
2872

            
2873
    sub { "%$_[0]%" }
2874

            
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
2875
=head2 C<mapper>
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
2876

            
2877
    my $mapper = $dbi->mapper(param => $param);
2878

            
2879
Create a new L<DBIx::Custom::Mapper> object.
2880

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

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

            
cleanup
Yuki Kimoto authored on 2011-10-20
2885
Merge parameters. The following new parameter is created.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2886

            
2887
    {key1 => [1, 1], key2 => 2}
2888

            
cleanup
Yuki Kimoto authored on 2011-10-20
2889
If same keys contains, the value is converted to array reference.
2890

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

            
2893
    my $model = $dbi->model('book');
2894

            
cleanup
Yuki Kimoto authored on 2011-10-20
2895
Get a L<DBIx::Custom::Model> object
2896
create by C<create_model> or C<include_model>
update pod
Yuki Kimoto authored on 2011-03-13
2897

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

            
fixed pod
Yuki Kimoto authored on 2011-09-27
2900
    my $column = $dbi->mycolumn(book => ['author', 'title']);
cleanup
Yuki Kimoto authored on 2011-03-21
2901

            
2902
Create column clause for myself. The follwoing column clause is created.
2903

            
2904
    book.author as author,
2905
    book.title as title
2906

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2909
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2910
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2911
        user => 'ken',
2912
        password => '!LFKD%$&',
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
2913
        option => {mysql_enable_utf8 => 1}
update pod
Yuki Kimoto authored on 2011-03-13
2914
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2915

            
2916
Create a new L<DBIx::Custom> object.
2917

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

            
2920
    my $not_exists = $dbi->not_exists;
2921

            
update pod
Yuki Kimoto authored on 2011-03-13
2922
DBIx::Custom::NotExists object, indicating the column is not exists.
cleanup
Yuki Kimoto authored on 2011-10-20
2923
This is used in C<param> of L<DBIx::Custom::Where> .
experimental extended select...
Yuki Kimoto authored on 2011-01-17
2924

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
2925
=head2 C<order>
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
2926

            
2927
    my $order = $dbi->order;
2928

            
2929
Create a new L<DBIx::Custom::Order> object.
2930

            
cleanup
yuki-kimoto authored on 2010-10-17
2931
=head2 C<register_filter>
2932

            
update pod
Yuki Kimoto authored on 2011-03-13
2933
    $dbi->register_filter(
2934
        # Time::Piece object to database DATE format
2935
        tp_to_date => sub {
2936
            my $tp = shift;
2937
            return $tp->strftime('%Y-%m-%d');
2938
        },
2939
        # database DATE format to Time::Piece object
2940
        date_to_tp => sub {
2941
           my $date = shift;
2942
           return Time::Piece->strptime($date, '%Y-%m-%d');
2943
        }
2944
    );
cleanup
yuki-kimoto authored on 2010-10-17
2945
    
update pod
Yuki Kimoto authored on 2011-03-13
2946
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2947

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2950
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2951
        table  => 'book',
2952
        column => ['author', 'title'],
2953
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2954
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2955
    
updated document
Yuki Kimoto authored on 2011-06-09
2956
Execute select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2957

            
cleanup
Yuki Kimoto authored on 2011-10-20
2958
B<OPTIONS>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2959

            
cleanup
Yuki Kimoto authored on 2011-10-20
2960
C<select> method use all of C<execute> method's options,
2961
and use the following new ones.
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
2962

            
cleanup
Yuki Kimoto authored on 2011-10-20
2963
=over 4
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
2964

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2965
=item C<column>
2966
    
updated document
Yuki Kimoto authored on 2011-06-09
2967
    column => 'author'
2968
    column => ['author', 'title']
2969

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

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

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
2976
You can specify hash of array reference.
updated pod
Yuki Kimoto authored on 2011-06-07
2977

            
updated document
Yuki Kimoto authored on 2011-06-09
2978
    column => [
updated pod
Yuki Kimoto authored on 2011-06-07
2979
        {book => [qw/author title/]},
2980
        {person => [qw/name age/]}
updated document
Yuki Kimoto authored on 2011-06-09
2981
    ]
updated pod
Yuki Kimoto authored on 2011-06-07
2982

            
updated pod
Yuki Kimoto authored on 2011-06-21
2983
This is expanded to the following one by using C<colomn> method.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2984

            
2985
    book.author as "book.author",
2986
    book.title as "book.title",
2987
    person.name as "person.name",
2988
    person.age as "person.age"
2989

            
- select method column optio...
Yuki Kimoto authored on 2011-07-11
2990
You can specify array of array reference, first argument is
2991
column name, second argument is alias.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2992

            
updated document
Yuki Kimoto authored on 2011-06-09
2993
    column => [
- select method column optio...
Yuki Kimoto authored on 2011-07-11
2994
        ['date(book.register_datetime)' => 'book.register_date']
updated document
Yuki Kimoto authored on 2011-06-09
2995
    ];
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2996

            
- select method column optio...
Yuki Kimoto authored on 2011-07-11
2997
Alias is quoted properly and joined.
- select() column option can...
Yuki Kimoto authored on 2011-06-08
2998

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

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

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

            
3005
=item C<id>
3006

            
3007
    id => 4
3008
    id => [4, 5]
3009

            
3010
ID corresponding to C<primary_key>.
3011
You can select rows by C<id> and C<primary_key>.
3012

            
3013
    $dbi->select(
fixed pod
Yuki Kimoto authored on 2011-10-20
3014
        primary_key => ['id1', 'id2'],
updated document
Yuki Kimoto authored on 2011-06-09
3015
        id => [4, 5],
3016
        table => 'book'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3017
    );
3018

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
3021
    $dbi->select(
updated document
Yuki Kimoto authored on 2011-06-09
3022
        where => {id1 => 4, id2 => 5},
3023
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
3024
    );
3025
    
cleanup
Yuki Kimoto authored on 2011-10-20
3026
=item C<param>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3027

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

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

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

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
3038
=itme C<prefix>
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
3039

            
3040
    prefix => 'SQL_CALC_FOUND_ROWS'
3041

            
3042
Prefix of column cluase
3043

            
3044
    select SQL_CALC_FOUND_ROWS title, author from book;
3045

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

            
3048
    join => [
3049
        'left outer join company on book.company_id = company_id',
3050
        'left outer join location on company.location_id = location.id'
3051
    ]
3052
        
3053
Join clause. If column cluase or where clause contain table name like "company.name",
3054
join clausees needed when SQL is created is used automatically.
update pod
Yuki Kimoto authored on 2011-03-12
3055

            
3056
    $dbi->select(
3057
        table => 'book',
cleanup
Yuki Kimoto authored on 2011-06-13
3058
        column => ['company.location_id as location_id'],
update pod
Yuki Kimoto authored on 2011-03-12
3059
        where => {'company.name' => 'Orange'},
3060
        join => [
3061
            'left outer join company on book.company_id = company.id',
3062
            'left outer join location on company.location_id = location.id'
3063
        ]
3064
    );
3065

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
3069
    select company.location_id as location_id
update pod
Yuki Kimoto authored on 2011-03-12
3070
    from book
3071
      left outer join company on book.company_id = company.id
cleanup
Yuki Kimoto authored on 2011-06-13
3072
    where company.name = ?;
update pod
Yuki Kimoto authored on 2011-03-12
3073

            
added join new syntax
Yuki Kimoto authored on 2011-07-28
3074
You can specify two table by yourself. This is useful when join parser can't parse
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
3075
the join clause correctly.
added join new syntax
Yuki Kimoto authored on 2011-07-28
3076

            
3077
    $dbi->select(
3078
        table => 'book',
3079
        column => ['company.location_id as location_id'],
3080
        where => {'company.name' => 'Orange'},
3081
        join => [
3082
            {
3083
                clause => 'left outer join location on company.location_id = location.id',
3084
                table => ['company', 'location']
3085
            }
3086
        ]
3087
    );
3088

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3093
Table name.
updated pod
Yuki Kimoto authored on 2011-06-08
3094

            
updated document
Yuki Kimoto authored on 2011-06-09
3095
=item C<where>
3096
    
3097
    # Hash refrence
3098
    where => {author => 'Ken', 'title' => 'Perl'}
3099
    
3100
    # DBIx::Custom::Where object
3101
    where => $dbi->where(
3102
        clause => ['and', 'author = :author', 'title like :title'],
3103
        param  => {author => 'Ken', title => '%Perl%'}
3104
    );
updated pod
Yuki Kimoto authored on 2011-06-21
3105
    
3106
    # Array reference 1 (array reference, hash referenc). same as above
3107
    where => [
3108
        ['and', 'author = :author', 'title like :title'],
3109
        {author => 'Ken', title => '%Perl%'}
3110
    ];    
3111
    
3112
    # Array reference 2 (String, hash reference)
3113
    where => [
3114
        'title like :title',
3115
        {title => '%Perl%'}
3116
    ]
3117
    
3118
    # String
3119
    where => 'title is null'
update pod
Yuki Kimoto authored on 2011-03-12
3120

            
cleanup
Yuki Kimoto authored on 2011-10-20
3121
Where clause. See L<DBIx::Custom::Where>.
updated document
Yuki Kimoto authored on 2011-06-09
3122
    
update pod
Yuki Kimoto authored on 2011-03-12
3123
=back
cleanup
Yuki Kimoto authored on 2011-03-08
3124

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3125
=head2 C<setup_model>
3126

            
3127
    $dbi->setup_model;
3128

            
3129
Setup all model objects.
3130
C<columns> of model object is automatically set, parsing database information.
3131

            
3132
=head2 C<type_rule>
3133

            
3134
    $dbi->type_rule(
3135
        into1 => {
3136
            date => sub { ... },
3137
            datetime => sub { ... }
3138
        },
3139
        into2 => {
3140
            date => sub { ... },
3141
            datetime => sub { ... }
3142
        },
3143
        from1 => {
3144
            # DATE
3145
            9 => sub { ... },
3146
            # DATETIME or TIMESTAMP
3147
            11 => sub { ... },
3148
        }
3149
        from2 => {
3150
            # DATE
3151
            9 => sub { ... },
3152
            # DATETIME or TIMESTAMP
3153
            11 => sub { ... },
3154
        }
3155
    );
3156

            
3157
Filtering rule when data is send into and get from database.
3158
This has a little complex problem.
3159

            
3160
In C<into1> and C<into2> you can specify
3161
type name as same as type name defined
3162
by create table, such as C<DATETIME> or C<DATE>.
3163

            
3164
Note that type name and data type don't contain upper case.
3165
If these contain upper case charactor, you convert it to lower case.
3166

            
3167
C<into2> is executed after C<into1>.
3168

            
3169
Type rule of C<into1> and C<into2> is enabled on the following
3170
column name.
3171

            
3172
=over 4
3173

            
3174
=item 1. column name
3175

            
3176
    issue_date
3177
    issue_datetime
3178

            
3179
This need C<table> option in each method.
3180

            
3181
=item 2. table name and column name, separator is dot
3182

            
3183
    book.issue_date
3184
    book.issue_datetime
3185

            
3186
=back
3187

            
3188
You get all type name used in database by C<available_typename>.
3189

            
3190
    print $dbi->available_typename;
3191

            
3192
In C<from1> and C<from2> you specify data type, not type name.
3193
C<from2> is executed after C<from1>.
3194
You get all data type by C<available_datatype>.
3195

            
3196
    print $dbi->available_datatype;
3197

            
3198
You can also specify multiple types at once.
3199

            
3200
    $dbi->type_rule(
3201
        into1 => [
3202
            [qw/DATE DATETIME/] => sub { ... },
3203
        ],
3204
    );
3205

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

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

            
insert and update method's p...
Yuki Kimoto authored on 2011-07-29
3210
Execute update statement. First argument is update row data.
3211

            
3212
If you want to set constant value to row data, use scalar reference
3213
as parameter value.
3214

            
3215
    {date => \"NOW()"}
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
3216

            
cleanup
Yuki Kimoto authored on 2011-10-20
3217
B<OPTIONS>
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3218

            
cleanup
Yuki Kimoto authored on 2011-10-20
3219
C<update> method use all of C<execute> method's options,
3220
and use the following new ones.
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3221

            
cleanup
Yuki Kimoto authored on 2011-10-20
3222
=over 4
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3223

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3226
    id => 4
3227
    id => [4, 5]
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3228

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

            
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
3232
    $dbi->update(
updated document
Yuki Kimoto authored on 2011-06-09
3233
        {title => 'Perl', author => 'Ken'}
fixed pod
Yuki Kimoto authored on 2011-10-20
3234
        primary_key => ['id1', 'id2'],
updated document
Yuki Kimoto authored on 2011-06-09
3235
        id => [4, 5],
3236
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
3237
    );
update pod
Yuki Kimoto authored on 2011-03-13
3238

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3241
    $dbi->update(
3242
        {title => 'Perl', author => 'Ken'}
3243
        where => {id1 => 4, id2 => 5},
3244
        table => 'book'
3245
    );
update pod
Yuki Kimoto authored on 2011-03-13
3246

            
- removed EXPERIMENTAL statu...
Yuki Kimoto authored on 2011-07-26
3247
=item C<prefix>
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
3248

            
3249
    prefix => 'or replace'
3250

            
3251
prefix before table name section
3252

            
3253
    update or replace book
3254

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

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

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

            
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
3261
=item C<timestamp>
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
3262

            
3263
    timestamp => 1
3264

            
3265
If this value is set to 1,
3266
automatically updated timestamp column is set based on
3267
C<timestamp> attribute's C<update> value.
3268

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
3269
=item C<where>
3270

            
3271
Same as C<select> method's C<where> option.
3272

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
3273
=item C<wrap>
updated pod
Yuki Kimoto authored on 2011-09-02
3274

            
3275
    wrap => {price => sub { "max($_[0])" }}
3276

            
3277
placeholder wrapped string.
3278

            
3279
If the following statement
3280

            
3281
    $dbi->update({price => 100}, table => 'book',
3282
      {price => sub { "$_[0] + 5" }});
3283

            
3284
is executed, the following SQL is executed.
3285

            
3286
    update book set price =  ? + 5;
3287

            
updated pod
Yuki Kimoto authored on 2011-06-08
3288
=back
update pod
Yuki Kimoto authored on 2011-03-13
3289

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3294
Execute update statement for all rows.
updated pod
Yuki Kimoto authored on 2011-06-21
3295
Options is same as C<update> method.
update pod
Yuki Kimoto authored on 2011-03-13
3296

            
- removed DEPRECATED status ...
Yuki Kimoto authored on 2011-10-11
3297
=head2 C<update_or_insert EXPERIMENTAL>
3298
    
3299
    # Where
3300
    $dbi->update_or_insert(
3301
        {id => 1, title => 'Perl'},
3302
        table => 'book',
3303
        where => {id => 1},
3304
        select_option => {append => 'for update'}
3305
    );
3306
    
3307
    # ID
3308
    $dbi->update_or_insert(
3309
        {title => 'Perl'},
3310
        table => 'book',
3311
        id => 1,
3312
        primary_key => 'id',
3313
        select_option => {append => 'for update'}
3314
    );
3315
    
3316
Update or insert.
3317

            
3318
In both examples, the following SQL is executed.
3319

            
3320
    # In case insert
3321
    insert into book (id, title) values (?, ?)
3322
    
3323
    # In case update
3324
    update book set (id = ?, title = ?) where book.id = ?
3325

            
3326
The following opitons are available adding to C<update> option.
3327

            
3328
=over 4
3329

            
3330
=item C<select_option>
3331

            
3332
    select_option => {append => 'for update'}
3333

            
3334
select method option,
3335
select method is used to check the row is already exists.
3336

            
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
3337
=head2 C<update_timestamp>
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
3338

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3339
    $dbi->update_timestamp(
3340
      updated_at
3341
        => sub { Time::Piece->localtime->strftime("%Y-%m-%d %H:%M:%S") }
cleanup
Yuki Kimoto authored on 2011-03-09
3342
    );
fix tests
Yuki Kimoto authored on 2011-01-18
3343

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3344
Timestamp value when C<update> method is executed
3345
with C<timestamp> option.
cleanup
Yuki Kimoto authored on 2011-01-12
3346

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3347
If C<insert_timestamp> is set and C<insert> method is executed
3348
with C<timestamp> option, column C<update_at>
3349
is automatically set to the value like "2010-10-11 10:12:54".
cleanup
Yuki Kimoto authored on 2011-01-12
3350

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3351
>|perl|
3352
$dbi->update($param, table => 'book', timestamp => 1);
3353
||<
cleanup
Yuki Kimoto authored on 2011-01-12
3354

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
3355
=head2 C<show_datatype>
update pod
Yuki Kimoto authored on 2011-08-10
3356

            
3357
    $dbi->show_datatype($table);
3358

            
3359
Show data type of the columns of specified table.
3360

            
3361
    book
3362
    title: 5
3363
    issue_date: 91
3364

            
3365
This data type is used in C<type_rule>'s C<from1> and C<from2>.
3366

            
- removed EXPERIMENTAL the f...
Yuki Kimoto authored on 2011-09-12
3367
=head2 C<show_tables>
test cleanup
Yuki Kimoto authored on 2011-08-15
3368

            
3369
    $dbi->show_tables;
3370

            
3371
Show tables.
3372

            
- removed EXPERIMENTAL flag ...
Yuki Kimoto authored on 2011-09-12
3373
=head2 C<show_typename>
update pod
Yuki Kimoto authored on 2011-08-10
3374

            
3375
    $dbi->show_typename($table);
3376

            
3377
Show type name of the columns of specified table.
3378

            
3379
    book
3380
    title: varchar
3381
    issue_date: date
3382

            
3383
This type name is used in C<type_rule>'s C<into1> and C<into2>.
3384

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-10-19
3385
=head2 C<values_clause>
3386

            
3387
    my $values_clause = $dbi->values_clause({title => 'a', age => 2});
3388

            
3389
Create values clause.
3390

            
3391
    (title, author) values (title = :title, age = :age);
3392

            
3393
You can use this in insert statement.
3394

            
3395
    my $insert_sql = "insert into book $values_clause";
3396

            
3397
=head2 C<where>
3398

            
3399
    my $where = $dbi->where(
3400
        clause => ['and', 'title = :title', 'author = :author'],
3401
        param => {title => 'Perl', author => 'Ken'}
3402
    );
3403

            
3404
Create a new L<DBIx::Custom::Where> object.
3405

            
- added EXPERIMENTAL update_...
Yuki Kimoto authored on 2011-09-12
3406
=head1 ENVIRONMENTAL VARIABLES
3407

            
3408
=head2 C<DBIX_CUSTOM_DEBUG>
3409

            
3410
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
3411
executed SQL and bind values are printed to STDERR.
3412

            
improved debug message
Yuki Kimoto authored on 2011-05-23
3413
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
3414

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

            
fix heading typos
Terrence Brannon authored on 2011-08-17
3417
=head1 DEPRECATED FUNCTIONALITY
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3418

            
3419
L<DBIx::Custom>
3420

            
3421
    # Attribute methods
- dbi_option attribute is re...
Yuki Kimoto authored on 2011-10-05
3422
    default_dbi_option # will be removed 2017/1/1
3423
    dbi_option # will be removed 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3424
    data_source # will be removed at 2017/1/1
3425
    dbi_options # will be removed at 2017/1/1
3426
    filter_check # will be removed at 2017/1/1
3427
    reserved_word_quote # will be removed at 2017/1/1
3428
    cache_method # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3429
    
3430
    # Methods
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
3431
    method # will be removed at 2017/1/1
- update_param is DEPRECATED...
Yuki Kimoto authored on 2011-10-04
3432
    assign_param # will be removed at 2017/1/1
3433
    update_param # will be removed at 2017/1/1
3434
    insert_param # will be removed at 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3435
    create_query # will be removed at 2017/1/1
3436
    apply_filter # will be removed at 2017/1/1
3437
    select_at # will be removed at 2017/1/1
3438
    delete_at # will be removed at 2017/1/1
3439
    update_at # will be removed at 2017/1/1
3440
    insert_at # will be removed at 2017/1/1
3441
    register_tag # will be removed at 2017/1/1
3442
    default_bind_filter # will be removed at 2017/1/1
3443
    default_fetch_filter # will be removed at 2017/1/1
3444
    insert_param_tag # will be removed at 2017/1/1
update pod
Yuki Kimoto authored on 2011-08-10
3445
    register_tag # will be removed at 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3446
    register_tag_processor # will be removed at 2017/1/1
3447
    update_param_tag # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3448
    
3449
    # Options
cleanup
Yuki Kimoto authored on 2011-10-21
3450
    select method where_param option # will be removed 2017/1/1
cleanup
Yuki Kimoto authored on 2011-10-21
3451
    delete method where_param option # will be removed 2017/1/1
cleanup
Yuki Kimoto authored on 2011-10-21
3452
    update method where_param option # will be removed 2017/1/1
cleanup
Yuki Kimoto authored on 2011-10-21
3453
    insert method param option # will be removed at 2017/1/1
insert method's id option is...
Yuki Kimoto authored on 2011-10-10
3454
    insert method id option # will be removed at 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3455
    select method relation option # will be removed at 2017/1/1
3456
    select method column option [COLUMN, as => ALIAS] format
3457
      # will be removed at 2017/1/1
sqlfilter option is renamed ...
Yuki Kimoto authored on 2011-09-16
3458
    execute method's sqlfilter option # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3459
    
3460
    # Others
cleanup
Yuki Kimoto authored on 2011-07-28
3461
    execute("select * from {= title}"); # execute method's
3462
                                        # tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3463
                                        # will be removed at 2017/1/1
3464
    Query caching # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3465

            
3466
L<DBIx::Custom::Model>
3467

            
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3468
    # Attribute methods
- method method of DBIx::Cus...
Yuki Kimoto authored on 2011-10-10
3469
    method # will be removed at 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3470
    filter # will be removed at 2017/1/1
3471
    name # will be removed at 2017/1/1
3472
    type # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3473

            
3474
L<DBIx::Custom::Query>
3475
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3476
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3477
    default_filter # will be removed at 2017/1/1
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3478
    table # will be removed at 2017/1/1
3479
    filters # will be removed at 2017/1/1
3480
    
3481
    # Methods
3482
    filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3483

            
3484
L<DBIx::Custom::QueryBuilder>
3485
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3486
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3487
    tags # will be removed at 2017/1/1
3488
    tag_processors # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3489
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3490
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3491
    register_tag # will be removed at 2017/1/1
3492
    register_tag_processor # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3493
    
3494
    # Others
3495
    build_query("select * from {= title}"); # tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3496
                                            # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3497

            
3498
L<DBIx::Custom::Result>
3499
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3500
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3501
    filter_check # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3502
    
3503
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3504
    end_filter # will be removed at 2017/1/1
3505
    remove_end_filter # will be removed at 2017/1/1
3506
    remove_filter # will be removed at 2017/1/1
3507
    default_filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3508

            
3509
L<DBIx::Custom::Tag>
3510

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3511
    This module is DEPRECATED! # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3512

            
fix heading typos
Terrence Brannon authored on 2011-08-17
3513
=head1 BACKWARDS COMPATIBILITY POLICY
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3514

            
3515
If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3516
except for attribute method.
3517
You can check all DEPRECATED functionalities by document.
3518
DEPRECATED functionality is removed after five years,
3519
but if at least one person use the functionality and tell me that thing
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3520
I extend one year each time he tell me it.
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3521

            
3522
EXPERIMENTAL functionality will be changed without warnings.
DBIx::Custom is now stable
yuki-kimoto authored on 2010-09-07
3523

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

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

            
3528
C<< <kimoto.yuki at gmail.com> >>
3529

            
3530
L<http://github.com/yuki-kimoto/DBIx-Custom>
3531

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
3532
=head1 AUTHOR
3533

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

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

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

            
3540
This program is free software; you can redistribute it and/or modify it
3541
under the same terms as Perl itself.
3542

            
3543
=cut