DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
3108 lines | 80.523kb
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

            
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
4
our $VERSION = '0.1701';
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/;
improved debug message
Yuki Kimoto authored on 2011-05-23
17
use Encode qw/encode encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
18

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

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
22
our @COMMON_ARGS = qw/bind_type table query filter id primary_key
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
23
  type_rule_off type_rule1_off type_rule2_off type table_alias/;
cleanup
Yuki Kimoto authored on 2011-03-21
24

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

            
added helper method
yuki-kimoto authored on 2010-10-17
63
our $AUTOLOAD;
64
sub AUTOLOAD {
65
    my $self = shift;
66

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

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
84
sub assign_param {
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
85
    my ($self, $param) = @_;
86
    
87
    # Create set tag
88
    my @params;
89
    my $safety = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
90
    my $q = $self->_quote;
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
91
    foreach my $column (keys %$param) {
92
        croak qq{"$column" is not safety column name } . _subname
93
          unless $column =~ /^[$safety\.]+$/;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
94
        my $column_quote = "$q$column$q";
95
        $column_quote =~ s/\./$q.$q/;
96
        push @params, "$column_quote = :$column";
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
97
    }
98
    my $tag = join(', ', @params);
99
    
100
    return $tag;
101
}
102

            
cleanup
Yuki Kimoto authored on 2011-03-21
103
sub column {
- DBIx::Custom Model filter ...
Yuki Kimoto authored on 2011-06-15
104
    my $self = shift;
105
    my $option = pop if ref $_[-1] eq 'HASH';
106
    my $real_table = shift;
107
    my $columns = shift;
108
    my $table = $option->{alias} || $real_table;
109
    
110
    # Columns
111
    unless ($columns) {
112
        $columns ||= $self->model($real_table)->columns;
113
    }
added helper method
yuki-kimoto authored on 2010-10-17
114
    
cleanup
Yuki Kimoto authored on 2011-04-02
115
    # Reserved word quote
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
116
    my $q = $self->_quote;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
117
    
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
118
    # Separator
119
    my $separator = $self->separator;
120
    
cleanup
Yuki Kimoto authored on 2011-04-02
121
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
122
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
123
    $columns ||= [];
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
124
    push @column, "$q$table$q.$q$_$q as $q${table}${separator}$_$q"
125
      for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
126
    
127
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
128
}
129

            
packaging one directory
yuki-kimoto authored on 2009-11-16
130
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
131
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
132
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
133
    # Connect
134
    $self->dbh;
update document
yuki-kimoto authored on 2010-01-30
135
    
packaging one directory
yuki-kimoto authored on 2009-11-16
136
    return $self;
137
}
138

            
update pod
Yuki Kimoto authored on 2011-03-13
139
sub dbh {
140
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
141
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
142
    # Set
143
    if (@_) {
144
        $self->{dbh} = $_[0];
145
        
146
        return $self;
147
    }
148
    
149
    # Get
150
    else {
151
        # From Connction manager
152
        if (my $connector = $self->connector) {
cleanup
Yuki Kimoto authored on 2011-04-25
153
            croak "connector must have dbh() method " . _subname
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
154
              unless ref $connector && $connector->can('dbh');
155
              
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
156
            $self->{dbh} = $connector->dbh;
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
157
        }
158
        
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
159
        # Connect
160
        $self->{dbh} ||= $self->_connect;
161
        
162
        # Quote
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
163
        if (!defined $self->reserved_word_quote && !defined $self->quote) {
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
164
            my $driver = $self->{dbh}->{Driver}->{Name};
165
            my $quote = $driver eq 'mysql' ? '`' : '"';
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
166
            $self->quote($quote);
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
167
        }
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
168
        
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
169
        return $self->{dbh};
update pod
Yuki Kimoto authored on 2011-03-13
170
    }
171
}
172

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
173
our %DELETE_ARGS = map { $_ => 1 } @COMMON_ARGS,
174
  qw/where append allow_delete_all where_param prefix/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
175

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
179
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
180
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
181
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
182
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
183
    }
184
    
185
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
186
    my $table = $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
187
    croak qq{"table" option must be specified. } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
188
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
189
    my $where            = delete $args{where} || {};
190
    my $append           = delete $args{append};
191
    my $allow_delete_all = delete $args{allow_delete_all};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
192
    my $where_param      = delete $args{where_param} || {};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
193
    my $id = delete $args{id};
194
    my $primary_key = delete $args{primary_key};
195
    croak "update method primary_key option " .
196
          "must be specified when id is specified " . _subname
197
      if defined $id && !defined $primary_key;
198
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
199
    my $prefix = delete $args{prefix};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
200
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
201
    # Where
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
202
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
203
    my $where_clause = '';
updated pod
Yuki Kimoto authored on 2011-06-21
204
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
205
        $where_clause = "where " . $where->[0];
206
        $where_param = $where->[1];
207
    }
208
    elsif (ref $where) {
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
209
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
210
        $where_param = keys %$where_param
211
                     ? $self->merge_param($where_param, $where->param)
212
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
213
        
214
        # String where
215
        $where_clause = $where->to_string;
216
    }
217
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
218
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
219
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
220

            
cleanup
Yuki Kimoto authored on 2011-04-02
221
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
222
    my @sql;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
223
    my $q = $self->_quote;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
224
    push @sql, "delete";
225
    push @sql, $prefix if defined $prefix;
226
    push @sql, "from $q$table$q $where_clause";
227
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
228
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
229
    
230
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
231
    return $self->execute($sql, $where_param, table => $table, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
232
}
233

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

            
added helper method
yuki-kimoto authored on 2010-10-17
236
sub DESTROY { }
237

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
238
sub create_model {
239
    my $self = shift;
240
    
cleanup
Yuki Kimoto authored on 2011-04-02
241
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
242
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
243
    $args->{dbi} = $self;
244
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
245
    my $model_name  = delete $args->{name};
246
    my $model_table = delete $args->{table};
247
    $model_name ||= $model_table;
248
    
cleanup
Yuki Kimoto authored on 2011-04-02
249
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
250
    my $model = $model_class->new($args);
251
    $model->name($model_name) unless $model->name;
252
    $model->table($model_table) unless $model->table;
253
    
254
    # Apply filter
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
255
    my $filter = ref $model->filter eq 'HASH'
256
               ? [%{$model->filter}]
257
               : $model->filter;
- DBIx::Custom Model filter ...
Yuki Kimoto authored on 2011-06-15
258
    warn "DBIx::Custom::Model filter method is DEPRECATED!"
259
      if @$filter;
cleanup
Yuki Kimoto authored on 2011-06-13
260
    $self->_apply_filter($model->table, @$filter);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
261

            
262
    # Set model
263
    $self->model($model->name, $model);
264
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
265
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
266
}
267

            
268
sub each_column {
269
    my ($self, $cb) = @_;
270
    
271
    # Iterate all tables
272
    my $sth_tables = $self->dbh->table_info;
273
    while (my $table_info = $sth_tables->fetchrow_hashref) {
274
        
275
        # Table
276
        my $table = $table_info->{TABLE_NAME};
277
        
278
        # Iterate all columns
279
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
280
        while (my $column_info = $sth_columns->fetchrow_hashref) {
281
            my $column = $column_info->{COLUMN_NAME};
282
            $self->$cb($table, $column, $column_info);
283
        }
284
    }
285
}
286

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
287
sub each_table {
288
    my ($self, $cb) = @_;
289
    
290
    # Iterate all tables
291
    my $sth_tables = $self->dbh->table_info;
292
    while (my $table_info = $sth_tables->fetchrow_hashref) {
293
        
294
        # Table
295
        my $table = $table_info->{TABLE_NAME};
296
        $self->$cb($table, $table_info);
297
    }
298
}
299

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

            
302
sub execute {
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
303
    my $self = shift;
304
    my $query = shift;
305
    my $param;
306
    $param = shift if @_ % 2;
307
    my %args = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
308
    
cleanup
Yuki Kimoto authored on 2011-04-02
309
    # Arguments
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
310
    my $p = delete $args{param} || {};
311
    $param ||= $p;
cleanup
Yuki Kimoto authored on 2011-04-02
312
    my $tables = delete $args{table} || [];
313
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
314
    my $filter = delete $args{filter};
cleanup
Yuki Kimoto authored on 2011-04-25
315
    $filter = _array_to_hash($filter);
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
316
    my $bind_type = delete $args{bind_type} || delete $args{type};
317
    $bind_type = _array_to_hash($bind_type);
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
318
    my $type_rule_off = delete $args{type_rule_off};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
319
    my $type_rule_off_parts = {
320
        1 => delete $args{type_rule1_off},
321
        2 => delete $args{type_rule2_off}
322
    };
cleanup
Yuki Kimoto authored on 2011-06-09
323
    my $query_return = delete $args{query};
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
324
    my $table_alias = delete $args{table_alias} || {};
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
325
    
cleanup
Yuki Kimoto authored on 2011-03-09
326
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
327
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
328
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
329
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
330
    }
331
    
cleanup
Yuki Kimoto authored on 2011-04-02
332
    # Create query
updated pod
Yuki Kimoto authored on 2011-06-21
333
    $query = $self->_create_query($query) unless ref $query;
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
334
    
335
    # Save query
336
    $self->last_sql($query->sql);
337

            
cleanup
Yuki Kimoto authored on 2011-06-09
338
    return $query if $query_return;
cleanup
Yuki Kimoto authored on 2011-04-02
339
    $filter ||= $query->filter;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
340
    
cleanup
Yuki Kimoto authored on 2011-04-02
341
    # Tables
342
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
343
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
344
    $tables = $self->_remove_duplicate_table($tables, $main_table);
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
345
    if (my $q = $self->_quote) {
cleanup
Yuki Kimoto authored on 2011-04-02
346
        $_ =~ s/$q//g for @$tables;
347
    }
cleanup
Yuki Kimoto authored on 2011-04-02
348
    
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
349
    # Type rule
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
350
    my $type_filters = {};
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
351
    unless ($type_rule_off) {
352
        foreach my $name (keys %$param) {
353
            my $table;
354
            my $column;
355
            if ($name =~ /(?:(.+)\.)?(.+)/) {
356
                $table = $1;
357
                $column = $2;
358
            }
359
            $table ||= $main_table;
360
            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
361
            foreach my $i (1 .. 2) {
362
                unless ($type_rule_off_parts->{$i}) {
363
                    my $into = $self->{"_into$i"} || {};
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
364
                    
365
                    my $alias = $table;
366
                    $table = $table_alias->{$alias}
367
                      if defined $alias && $table_alias->{$alias};
368
                    
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
369
                    if (defined $table && $into->{$table} &&
370
                        (my $rule = $into->{$table}->{$column}))
371
                    {
372
                        $type_filters->{$i}->{$column} = $rule;
373
                        $type_filters->{$i}->{"$table.$column"} = $rule;
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
374
                        $type_filters->{$i}->{"$alias.$column"} = $rule if $alias ne $table;
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
375
                    }
376
                }
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
377
            }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
378
        }
379
    }
cleanup
Yuki Kimoto authored on 2011-04-02
380
    
381
    # Applied filter
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
382
    my $applied_filter = {};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
383
    foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
384
        $applied_filter = {
385
            %$applied_filter,
cleanup
Yuki Kimoto authored on 2011-01-12
386
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
387
        }
388
    }
cleanup
Yuki Kimoto authored on 2011-04-02
389
    $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
390
    
cleanup
Yuki Kimoto authored on 2011-04-02
391
    # Replace filter name to code
392
    foreach my $column (keys %$filter) {
393
        my $name = $filter->{$column};
394
        if (!defined $name) {
395
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
396
        }
cleanup
Yuki Kimoto authored on 2011-04-02
397
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
398
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
399
            unless exists $self->filters->{$name};
400
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
401
        }
402
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
403
    
cleanup
Yuki Kimoto authored on 2011-04-02
404
    # Create bind values
405
    my $bind = $self->_create_bind_values(
406
        $param,
407
        $query->columns,
408
        $filter,
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
409
        $type_filters,
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
410
        $bind_type
cleanup
Yuki Kimoto authored on 2011-04-02
411
    );
cleanup
yuki-kimoto authored on 2010-10-17
412
    
413
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
414
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
415
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
416
    eval {
417
        for (my $i = 0; $i < @$bind; $i++) {
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
418
            my $bind_type = $bind->[$i]->{bind_type};
419
            $sth->bind_param(
420
                $i + 1,
421
                $bind->[$i]->{value},
422
                $bind_type ? $bind_type : ()
423
            );
cleanup
Yuki Kimoto authored on 2011-03-21
424
        }
425
        $affected = $sth->execute;
426
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
427
    
428
    if ($@) {
429
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
430
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
431
    }
cleanup
yuki-kimoto authored on 2010-10-17
432
    
improved debug message
Yuki Kimoto authored on 2011-05-23
433
    # DEBUG message
434
    if (DEBUG) {
435
        print STDERR "SQL:\n" . $query->sql . "\n";
436
        my @output;
437
        foreach my $b (@$bind) {
438
            my $value = $b->{value};
439
            $value = 'undef' unless defined $value;
440
            $value = encode(DEBUG_ENCODING(), $value)
441
              if utf8::is_utf8($value);
442
            push @output, $value;
443
        }
444
        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
445
    }
added environment variable D...
Yuki Kimoto authored on 2011-04-02
446
    
cleanup
Yuki Kimoto authored on 2011-04-02
447
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
448
    if ($sth->{NUM_OF_FIELDS}) {
449
        
cleanup
Yuki Kimoto authored on 2011-04-02
450
        # Filter
451
        my $filter = {};
452
        $filter->{in}  = {};
453
        $filter->{end} = {};
added DBIx::Custom result_fi...
Yuki Kimoto authored on 2011-06-12
454
        push @$tables, $main_table if $main_table;
cleanup
Yuki Kimoto authored on 2011-01-12
455
        foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
456
            foreach my $way (qw/in end/) {
457
                $filter->{$way} = {
458
                    %{$filter->{$way}},
459
                    %{$self->{filter}{$way}{$table} || {}}
460
                };
461
            }
cleanup
Yuki Kimoto authored on 2011-01-12
462
        }
463
        
464
        # Result
465
        my $result = $self->result_class->new(
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
466
            sth => $sth,
467
            filters => $self->filters,
cleanup
Yuki Kimoto authored on 2011-01-12
468
            default_filter => $self->{default_in_filter},
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
469
            filter => $filter->{in} || {},
470
            end_filter => $filter->{end} || {},
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
471
            type_rule => {
472
                from1 => $self->type_rule->{from1},
473
                from2 => $self->type_rule->{from2}
474
            },
cleanup
yuki-kimoto authored on 2010-10-17
475
        );
476

            
477
        return $result;
478
    }
cleanup
Yuki Kimoto authored on 2011-04-02
479
    
480
    # Not select statement
481
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
482
}
483

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

            
cleanup
yuki-kimoto authored on 2010-10-17
486
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
487
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
488
    
cleanup
yuki-kimoto authored on 2010-10-17
489
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
490
    my $param;
491
    $param = shift if @_ % 2;
492
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
493
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
494
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
495
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
496
    my $p = delete $args{param} || {};
497
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
498
    my $append = delete $args{append} || '';
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
499
    my $id = delete $args{id};
500
    my $primary_key = delete $args{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
501
    croak "insert method primary_key option " .
added tests
Yuki Kimoto authored on 2011-06-08
502
          "must be specified when id is specified " . _subname
503
      if defined $id && !defined $primary_key;
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
504
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
505
    my $prefix = delete $args{prefix};
cleanup
Yuki Kimoto authored on 2011-04-02
506

            
507
    # Check arguments
508
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
509
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
510
          unless $INSERT_ARGS{$name};
511
    }
512

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
513
    # Merge parameter
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
514
    if (defined $id) {
cleanup
Yuki Kimoto authored on 2011-06-08
515
        my $id_param = $self->_create_param_from_id($id, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
516
        $param = $self->merge_param($id_param, $param);
517
    }
518

            
cleanup
Yuki Kimoto authored on 2011-04-02
519
    # Reserved word quote
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
520
    my $q = $self->_quote;
cleanup
yuki-kimoto authored on 2010-10-17
521
    
cleanup
Yuki Kimoto authored on 2011-04-02
522
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
523
    my @sql;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
524
    push @sql, "insert";
525
    push @sql, $prefix if defined $prefix;
526
    push @sql, "into $q$table$q " . $self->insert_param($param);
527
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
528
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
529
    
530
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
531
    return $self->execute($sql, $param, table => $table, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
532
}
533

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
534
sub insert_param {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
535
    my ($self, $param) = @_;
536
    
cleanup
Yuki Kimoto authored on 2011-04-02
537
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
538
    my $safety = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
539
    my $q = $self->_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
540
    my @columns;
541
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
542
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
543
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
544
          unless $column =~ /^[$safety\.]+$/;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
545
        my $column_quote = "$q$column$q";
546
        $column_quote =~ s/\./$q.$q/;
547
        push @columns, $column_quote;
548
        push @placeholders, ":$column";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
549
    }
550
    
cleanup
Yuki Kimoto authored on 2011-04-02
551
    return '(' . join(', ', @columns) . ') ' . 'values ' .
552
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
553
}
554

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
555
sub include_model {
556
    my ($self, $name_space, $model_infos) = @_;
557
    
cleanup
Yuki Kimoto authored on 2011-04-02
558
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
559
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
560
    
561
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
562
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
563

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
564
        # Load name space module
cleanup
Yuki Kimoto authored on 2011-04-25
565
        croak qq{"$name_space" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
566
          if $name_space =~ /[^\w:]/;
567
        eval "use $name_space";
cleanup
Yuki Kimoto authored on 2011-04-25
568
        croak qq{Name space module "$name_space.pm" is needed. $@ }
569
            . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
570
          if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
571
        
572
        # Search model modules
573
        my $path = $INC{"$name_space.pm"};
574
        $path =~ s/\.pm$//;
575
        opendir my $dh, $path
cleanup
Yuki Kimoto authored on 2011-04-25
576
          or croak qq{Can't open directory "$path": $! } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
577
        $model_infos = [];
578
        while (my $module = readdir $dh) {
579
            push @$model_infos, $module
580
              if $module =~ s/\.pm$//;
581
        }
582
        close $dh;
583
    }
584
    
cleanup
Yuki Kimoto authored on 2011-04-02
585
    # Include models
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
586
    foreach my $model_info (@$model_infos) {
587
        
cleanup
Yuki Kimoto authored on 2011-04-02
588
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
589
        my $model_class;
590
        my $model_name;
591
        my $model_table;
592
        if (ref $model_info eq 'HASH') {
593
            $model_class = $model_info->{class};
594
            $model_name  = $model_info->{name};
595
            $model_table = $model_info->{table};
596
            
597
            $model_name  ||= $model_class;
598
            $model_table ||= $model_name;
599
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
600
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
601
        my $mclass = "${name_space}::$model_class";
cleanup
Yuki Kimoto authored on 2011-04-25
602
        croak qq{"$mclass" is invalid class name } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
603
          if $mclass =~ /[^\w:]/;
604
        unless ($mclass->can('isa')) {
605
            eval "use $mclass";
cleanup
Yuki Kimoto authored on 2011-04-25
606
            croak "$@ " . _subname if $@;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
607
        }
608
        
cleanup
Yuki Kimoto authored on 2011-04-02
609
        # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
610
        my $args = {};
611
        $args->{model_class} = $mclass if $mclass;
612
        $args->{name}        = $model_name if $model_name;
613
        $args->{table}       = $model_table if $model_table;
614
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
615
    }
616
    
617
    return $self;
618
}
619

            
added EXPERIMENTAL map_param...
Yuki Kimoto authored on 2011-06-24
620
sub map_param {
621
    my $self = shift;
622
    my $param = shift;
623
    my %map = @_;
624
    
625
    # Mapping
626
    my $map_param = {};
627
    foreach my $key (keys %map) {
628
        my $value_cb;
629
        my $condition;
630
        my $map_key;
631
        
632
        # Get mapping information
633
        if (ref $map{$key} eq 'ARRAY') {
634
            foreach my $some (@{$map{$key}}) {
635
                $map_key = $some unless ref $some;
636
                $condition = $some->{if} if ref $some eq 'HASH';
637
                $value_cb = $some if ref $some eq 'CODE';
638
            }
639
        }
640
        else {
641
            $map_key = $map{$key};
642
        }
643
        $value_cb ||= sub { $_[0] };
644
        $condition ||= sub { defined $_[0] && length $_[0] };
645

            
646
        # Map parameter
647
        my $value;
648
        if (ref $condition eq 'CODE') {
649
            $map_param->{$map_key} = $value_cb->($param->{$key})
650
              if $condition->($param->{$key});
651
        }
652
        elsif ($condition eq 'exists') {
653
            $map_param->{$map_key} = $value_cb->($param->{$key})
654
              if exists $param->{$key};
655
        }
656
        else { croak qq/Condition must be code reference or "exists" / . _subname }
657
    }
658
    
659
    return $map_param;
660
}
661

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
662
sub merge_param {
663
    my ($self, @params) = @_;
664
    
cleanup
Yuki Kimoto authored on 2011-04-02
665
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
666
    my $merge = {};
667
    foreach my $param (@params) {
668
        foreach my $column (keys %$param) {
669
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
670
            
671
            if (exists $merge->{$column}) {
672
                $merge->{$column} = [$merge->{$column}]
673
                  unless ref $merge->{$column} eq 'ARRAY';
674
                push @{$merge->{$column}},
675
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
676
            }
677
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
678
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
679
            }
680
        }
681
    }
682
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
683
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
684
}
685

            
cleanup
Yuki Kimoto authored on 2011-03-21
686
sub method {
687
    my $self = shift;
688
    
cleanup
Yuki Kimoto authored on 2011-04-02
689
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
690
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
691
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
692
    
693
    return $self;
694
}
695

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
696
sub model {
697
    my ($self, $name, $model) = @_;
698
    
cleanup
Yuki Kimoto authored on 2011-04-02
699
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
700
    if ($model) {
701
        $self->models->{$name} = $model;
702
        return $self;
703
    }
704
    
705
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
706
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
707
      unless $self->models->{$name};
708
    
cleanup
Yuki Kimoto authored on 2011-04-02
709
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
710
    return $self->models->{$name};
711
}
712

            
cleanup
Yuki Kimoto authored on 2011-03-21
713
sub mycolumn {
714
    my ($self, $table, $columns) = @_;
715
    
cleanup
Yuki Kimoto authored on 2011-04-02
716
    # Create column clause
717
    my @column;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
718
    my $q = $self->_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
719
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
720
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
721
    
722
    return join (', ', @column);
723
}
724

            
added dbi_options attribute
kimoto authored on 2010-12-20
725
sub new {
726
    my $self = shift->SUPER::new(@_);
727
    
cleanup
Yuki Kimoto authored on 2011-04-02
728
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
729
    my @attrs = keys %$self;
730
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
731
        croak qq{"$attr" is wrong name } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
732
          unless $self->can($attr);
733
    }
cleanup
Yuki Kimoto authored on 2011-04-02
734
    
set reserved_word_quote auto...
Yuki Kimoto authored on 2011-06-08
735
    # DEPRECATED!
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
736
    $self->query_builder->{tags} = {
cleanup
Yuki Kimoto authored on 2011-01-25
737
        '?'     => \&DBIx::Custom::Tag::placeholder,
738
        '='     => \&DBIx::Custom::Tag::equal,
739
        '<>'    => \&DBIx::Custom::Tag::not_equal,
740
        '>'     => \&DBIx::Custom::Tag::greater_than,
741
        '<'     => \&DBIx::Custom::Tag::lower_than,
742
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
743
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
744
        'like'  => \&DBIx::Custom::Tag::like,
745
        'in'    => \&DBIx::Custom::Tag::in,
746
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
747
        'update_param' => \&DBIx::Custom::Tag::update_param
fixed DEPRECATED messages
Yuki Kimoto authored on 2011-06-08
748
    };
added dbi_options attribute
kimoto authored on 2010-12-20
749
    
750
    return $self;
751
}
752

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

            
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
755
sub order {
756
    my $self = shift;
757
    return DBIx::Custom::Order->new(@_);
758
}
759

            
cleanup
yuki-kimoto authored on 2010-10-17
760
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
761
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
762
    
763
    # Register filter
764
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
765
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
766
    
cleanup
Yuki Kimoto authored on 2011-04-02
767
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
768
}
packaging one directory
yuki-kimoto authored on 2009-11-16
769

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
770
our %SELECT_ARGS = map { $_ => 1 } @COMMON_ARGS,
771
  qw/column where relation join param where_param wrap prefix/;
refactoring select
yuki-kimoto authored on 2010-04-28
772

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
776
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
777
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
778
    my $tables = ref $table eq 'ARRAY' ? $table
779
               : defined $table ? [$table]
780
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
781
    my $columns   = delete $args{column};
782
    my $where     = delete $args{where} || {};
783
    my $append    = delete $args{append};
784
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
785
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
786
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
787
    my $relation = delete $args{relation};
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
788
    warn "select() relation option is DEPRECATED!"
added warnings
Yuki Kimoto authored on 2011-06-07
789
      if $relation;
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
790
    my $param = delete $args{param} || {}; # DEPRECATED!
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
791
    warn "select() param option is DEPRECATED!"
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
792
      if keys %$param;
793
    my $where_param = delete $args{where_param} || $param || {};
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
794
    my $wrap = delete $args{wrap};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
795
    my $id = delete $args{id};
796
    my $primary_key = delete $args{primary_key};
797
    croak "update method primary_key option " .
798
          "must be specified when id is specified " . _subname
799
      if defined $id && !defined $primary_key;
800
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
801
    my $prefix = delete $args{prefix};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
802
    
cleanup
Yuki Kimoto authored on 2011-04-02
803
    # Check arguments
804
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
805
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
806
          unless $SELECT_ARGS{$name};
807
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
808
    
cleanup
Yuki Kimoto authored on 2011-03-09
809
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
810
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
811
    
cleanup
Yuki Kimoto authored on 2011-04-02
812
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
813
    my @sql;
814
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
815
    
- select() column option can...
Yuki Kimoto authored on 2011-06-08
816
    # Reserved word quote
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
817
    my $q = $self->_quote;
- select() column option can...
Yuki Kimoto authored on 2011-06-08
818
    
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
819
    # Prefix
820
    push @sql, $prefix if defined $prefix;
821
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
822
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
823
    if ($columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-07
824
        $columns = [$columns] unless ref $columns eq 'ARRAY';
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
825
        foreach my $column (@$columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-08
826
            if (ref $column eq 'HASH') {
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
827
                $column = $self->column(%$column) if ref $column eq 'HASH';
- select() column option can...
Yuki Kimoto authored on 2011-06-08
828
            }
829
            elsif (ref $column eq 'ARRAY') {
- select method column optio...
Yuki Kimoto authored on 2011-07-11
830
                if (@$column == 3 && $column->[1] eq 'as') {
831
                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
832
                    splice @$column, 1, 1;
833
                }
834
                
835
                $column = join(' ', $column->[0], 'as', $q . $column->[1] . $q);
- select() column option can...
Yuki Kimoto authored on 2011-06-08
836
            }
cleanup
Yuki Kimoto authored on 2011-04-02
837
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
838
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
839
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
840
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
841
    }
842
    else { push @sql, '*' }
843
    
844
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
845
    push @sql, 'from';
846
    if ($relation) {
847
        my $found = {};
848
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
849
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
850
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
851
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
852
    }
cleanup
Yuki Kimoto authored on 2011-03-30
853
    else {
854
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
855
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
856
    }
857
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
858
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
859
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
860

            
cleanup
Yuki Kimoto authored on 2011-04-02
861
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
862
    unshift @$tables,
863
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
864
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
865
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
866
    my $where_clause = '';
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
867
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
updated pod
Yuki Kimoto authored on 2011-06-21
868
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
869
        $where_clause = "where " . $where->[0];
870
        $where_param = $where->[1];
871
    }
872
    elsif (ref $where) {
cleanup
Yuki Kimoto authored on 2011-04-25
873
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
874
        $where_param = keys %$where_param
875
                     ? $self->merge_param($where_param, $where->param)
876
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
877
        
878
        # String where
879
        $where_clause = $where->to_string;
880
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
881
    elsif ($where) { $where_clause = "where $where" }
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-04-02
884
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
885
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
886
    # Push join
887
    $self->_push_join(\@sql, $join, $tables);
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-04-02
890
    push @sql, $where_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-04-02
893
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
894
    
cleanup
Yuki Kimoto authored on 2011-04-02
895
    # Append
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
896
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
897
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
898
    # Wrap
899
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
900
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
901
          unless ref $wrap eq 'ARRAY';
902
        unshift @sql, $wrap->[0];
903
        push @sql, $wrap->[1];
904
    }
905
    
cleanup
Yuki Kimoto authored on 2011-01-27
906
    # SQL
907
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
908
    
909
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
910
    my $result = $self->execute($sql, $where_param, table => $tables, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
911
    
912
    return $result;
913
}
914

            
added EXPERIMETNAL separator...
Yuki Kimoto authored on 2011-06-13
915
sub separator {
916
    my $self = shift;
917
    
918
    if (@_) {
919
        my $separator = $_[0] || '';
920
        croak qq{Separator must be "." or "__" or "-" } . _subname
921
          unless $separator eq '.' || $separator eq '__'
922
              || $separator eq '-';
923
        
924
        $self->{separator} = $separator;
925
    
926
        return $self;
927
    }
928
    return $self->{separator} ||= '.';
929
}
930

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
931
sub setup_model {
932
    my $self = shift;
933
    
cleanup
Yuki Kimoto authored on 2011-04-02
934
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
935
    $self->each_column(
936
        sub {
937
            my ($self, $table, $column, $column_info) = @_;
938
            if (my $model = $self->models->{$table}) {
939
                push @{$model->columns}, $column;
940
            }
941
        }
942
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
943
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
944
}
945

            
simplify type_rule
Yuki Kimoto authored on 2011-06-10
946
sub available_data_type {
947
    my $self = shift;
948
    
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
949
    my $data_types = '';
simplify type_rule
Yuki Kimoto authored on 2011-06-10
950
    foreach my $i (-1000 .. 1000) {
951
         my $type_info = $self->dbh->type_info($i);
952
         my $data_type = $type_info->{DATA_TYPE};
953
         my $type_name = $type_info->{TYPE_NAME};
954
         $data_types .= "$data_type ($type_name)\n"
955
           if defined $data_type;
956
    }
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
957
    return "Data Type maybe equal to Type Name" unless $data_types;
958
    $data_types = "Data Type (Type name)\n" . $data_types;
simplify type_rule
Yuki Kimoto authored on 2011-06-10
959
    return $data_types;
960
}
961

            
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
962
sub available_type_name {
963
    my $self = shift;
964
    
965
    # Type Names
966
    my $type_names = {};
967
    $self->each_column(sub {
968
        my ($self, $table, $column, $column_info) = @_;
969
        $type_names->{$column_info->{TYPE_NAME}} = 1
970
          if $column_info->{TYPE_NAME};
971
    });
972
    my @output = sort keys %$type_names;
973
    unshift @output, "Type Name";
974
    return join "\n", @output;
975
}
976

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
977
sub type_rule {
978
    my $self = shift;
979
    
980
    if (@_) {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
981
        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
982
        
983
        # Into
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
984
        foreach my $i (1 .. 2) {
985
            my $into = "into$i";
986
            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
987
            $self->{type_rule} = $type_rule;
988
            $self->{"_$into"} = {};
989
            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
990
                croak qq{type name of $into section must be lower case}
991
                  if $type_name =~ /[A-Z]/;
992
            }
993
            $self->each_column(sub {
994
                my ($dbi, $table, $column, $column_info) = @_;
995
                
996
                my $type_name = lc $column_info->{TYPE_NAME};
997
                if ($type_rule->{$into} &&
998
                    (my $filter = $type_rule->{$into}->{$type_name}))
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
999
                {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1000
                    return unless exists $type_rule->{$into}->{$type_name};
1001
                    if  (defined $filter && ref $filter ne 'CODE') 
1002
                    {
1003
                        my $fname = $filter;
1004
                        croak qq{Filter "$fname" is not registered" } . _subname
1005
                          unless exists $self->filters->{$fname};
1006
                        
1007
                        $filter = $self->filters->{$fname};
1008
                    }
1009

            
1010
                    $self->{"_$into"}{$table}{$column} = $filter;
1011
                }
1012
            });
1013
        }
1014

            
1015
        # From
1016
        foreach my $i (1 .. 2) {
1017
            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
1018
            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
1019
                croak qq{data type of from$i section must be lower case or number}
1020
                  if $data_type =~ /[A-Z]/;
1021
                my $fname = $type_rule->{"from$i"}{$data_type};
1022
                if (defined $fname && ref $fname ne 'CODE') {
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1023
                    croak qq{Filter "$fname" is not registered" } . _subname
1024
                      unless exists $self->filters->{$fname};
1025
                    
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1026
                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1027
                }
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1028
            }
1029
        }
1030
        
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1031
        return $self;
1032
    }
1033
    
1034
    return $self->{type_rule} || {};
1035
}
1036

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1037
our %UPDATE_ARGS = map { $_ => 1 } @COMMON_ARGS,
1038
  qw/param where allow_update_all where_param prefix/;
cleanup
yuki-kimoto authored on 2010-10-17
1039

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

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

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

            
1073
    # Where
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
1074
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1075
    my $where_clause = '';
updated pod
Yuki Kimoto authored on 2011-06-21
1076
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1077
        $where_clause = "where " . $where->[0];
1078
        $where_param = $where->[1];
1079
    }
1080
    elsif (ref $where) {
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1081
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1082
        $where_param = keys %$where_param
1083
                     ? $self->merge_param($where_param, $where->param)
1084
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1085
        
1086
        # String where
1087
        $where_clause = $where->to_string;
1088
    }
1089
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1090
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1091
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1092
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1093
    # Merge param
1094
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1095
    
cleanup
Yuki Kimoto authored on 2011-04-02
1096
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1097
    my @sql;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1098
    my $q = $self->_quote;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1099
    push @sql, "update";
1100
    push @sql, $prefix if defined $prefix;
1101
    push @sql, "$q$table$q $update_clause $where_clause";
1102
    push @sql, $append if defined $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1103
    
cleanup
Yuki Kimoto authored on 2011-01-27
1104
    # SQL
1105
    my $sql = join(' ', @sql);
1106
    
cleanup
yuki-kimoto authored on 2010-10-17
1107
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
1108
    return $self->execute($sql, $param, table => $table, %args);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1109
}
1110

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

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
1135
sub _create_query {
cleanup
Yuki Kimoto authored on 2011-06-13
1136
    
updated pod
Yuki Kimoto authored on 2011-06-21
1137
    my ($self, $source) = @_;
cleanup
Yuki Kimoto authored on 2011-06-13
1138
    
updated pod
Yuki Kimoto authored on 2011-06-21
1139
    # Cache
1140
    my $cache = $self->cache;
1141
    
1142
    # Query
1143
    my $query;
1144
    
1145
    # Get cached query
1146
    if ($cache) {
cleanup
Yuki Kimoto authored on 2011-06-13
1147
        
updated pod
Yuki Kimoto authored on 2011-06-21
1148
        # Get query
1149
        my $q = $self->cache_method->($self, $source);
cleanup
Yuki Kimoto authored on 2011-06-13
1150
        
updated pod
Yuki Kimoto authored on 2011-06-21
1151
        # Create query
1152
        if ($q) {
1153
            $query = DBIx::Custom::Query->new($q);
1154
            $query->filters($self->filters);
cleanup
Yuki Kimoto authored on 2011-06-13
1155
        }
updated pod
Yuki Kimoto authored on 2011-06-21
1156
    }
1157
    
1158
    # Create query
1159
    unless ($query) {
1160

            
1161
        # Create query
1162
        my $builder = $self->query_builder;
added tag_parse attribute
Yuki Kimoto authored on 2011-06-28
1163
        $builder->{_tag_parse} = $self->tag_parse;
updated pod
Yuki Kimoto authored on 2011-06-21
1164
        $query = $builder->build_query($source);
1165

            
1166
        # Remove reserved word quote
1167
        if (my $q = $self->_quote) {
1168
            $_ =~ s/$q//g for @{$query->columns}
cleanup
Yuki Kimoto authored on 2011-06-13
1169
        }
updated pod
Yuki Kimoto authored on 2011-06-21
1170

            
1171
        # Save query to cache
1172
        $self->cache_method->(
1173
            $self, $source,
1174
            {
1175
                sql     => $query->sql, 
1176
                columns => $query->columns,
1177
                tables  => $query->tables
1178
            }
1179
        ) if $cache;
cleanup
Yuki Kimoto authored on 2011-06-13
1180
    }
1181
    
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
1182
    # Save sql
1183
    $self->last_sql($query->sql);
1184
    
updated pod
Yuki Kimoto authored on 2011-06-21
1185
    # Prepare statement handle
1186
    my $sth;
1187
    eval { $sth = $self->dbh->prepare($query->{sql})};
1188
    
1189
    if ($@) {
1190
        $self->_croak($@, qq{. Following SQL is executed.\n}
1191
                        . qq{$query->{sql}\n} . _subname);
1192
    }
1193
    
1194
    # Set statement handle
1195
    $query->sth($sth);
1196
    
1197
    # Set filters
1198
    $query->filters($self->filters);
1199
    
1200
    return $query;
cleanup
Yuki Kimoto authored on 2011-06-13
1201
}
1202

            
cleanup
Yuki Kimoto authored on 2011-04-02
1203
sub _create_bind_values {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1204
    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1205
    
cleanup
Yuki Kimoto authored on 2011-04-02
1206
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1207
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1208
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1209
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1210
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1211
        
1212
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1213
        my $value;
1214
        if(ref $params->{$column} eq 'ARRAY') {
1215
            my $i = $count->{$column} || 0;
1216
            $i += $not_exists->{$column} || 0;
1217
            my $found;
1218
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1219
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1220
                    $not_exists->{$column}++;
1221
                }
1222
                else  {
1223
                    $value = $params->{$column}->[$k];
1224
                    $found = 1;
1225
                    last
1226
                }
1227
            }
1228
            next unless $found;
1229
        }
1230
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1231
        
cleanup
Yuki Kimoto authored on 2011-01-12
1232
        # Filter
1233
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
1234
        $value = $f->($value) if $f;
1235
        
1236
        # Type rule
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1237
        foreach my $i (1 .. 2) {
1238
            my $type_filter = $type_filters->{$i};
1239
            my $tf = $type_filter->{$column};
1240
            $value = $tf->($value) if $tf;
1241
        }
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1242
        
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
1243
        # Bind values
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
1244
        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1245
        
1246
        # Count up 
1247
        $count->{$column}++;
1248
    }
1249
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1250
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1251
}
1252

            
cleanup
Yuki Kimoto authored on 2011-06-08
1253
sub _create_param_from_id {
1254
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1255
    
cleanup
Yuki Kimoto authored on 2011-06-08
1256
    # Create parameter
1257
    my $param = {};
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
1258
    if (defined $id) {
cleanup
Yuki Kimoto authored on 2011-06-08
1259
        $id = [$id] unless ref $id;
1260
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1261
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1262
          unless !ref $id || ref $id eq 'ARRAY';
1263
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1264
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1265
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1266
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1267
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1268
        }
1269
    }
1270
    
cleanup
Yuki Kimoto authored on 2011-06-08
1271
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1272
}
1273

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1274
sub _connect {
1275
    my $self = shift;
1276
    
1277
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1278
    my $dsn = $self->data_source;
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1279
    warn "data_source is DEPRECATED!\n"
fixed bug that data_source D...
Yuki Kimoto authored on 2011-06-13
1280
      if $dsn;
added warnings
Yuki Kimoto authored on 2011-06-07
1281
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1282
    croak qq{"dsn" must be specified } . _subname
1283
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1284
    my $user        = $self->user;
1285
    my $password    = $self->password;
1286
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1287
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1288
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1289
    
1290
    # Connect
1291
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1292
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1293
        $user,
1294
        $password,
1295
        {
1296
            %{$self->default_dbi_option},
1297
            %$dbi_option
1298
        }
1299
    )};
1300
    
1301
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1302
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1303
    
1304
    return $dbh;
1305
}
1306

            
cleanup
yuki-kimoto authored on 2010-10-17
1307
sub _croak {
1308
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1309
    
1310
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1311
    $append ||= "";
1312
    
1313
    # Verbose
1314
    if ($Carp::Verbose) { croak $error }
1315
    
1316
    # Not verbose
1317
    else {
1318
        
1319
        # Remove line and module infromation
1320
        my $at_pos = rindex($error, ' at ');
1321
        $error = substr($error, 0, $at_pos);
1322
        $error =~ s/\s+$//;
1323
        croak "$error$append";
1324
    }
1325
}
1326

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1327
sub _need_tables {
1328
    my ($self, $tree, $need_tables, $tables) = @_;
1329
    
cleanup
Yuki Kimoto authored on 2011-04-02
1330
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1331
    foreach my $table (@$tables) {
1332
        if ($tree->{$table}) {
1333
            $need_tables->{$table} = 1;
1334
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1335
        }
1336
    }
1337
}
1338

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1339
sub _push_join {
1340
    my ($self, $sql, $join, $join_tables) = @_;
1341
    
cleanup
Yuki Kimoto authored on 2011-04-02
1342
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1343
    return unless @$join;
1344
    
cleanup
Yuki Kimoto authored on 2011-04-02
1345
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1346
    my $tree = {};
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1347
    my $q = $self->_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1348
    for (my $i = 0; $i < @$join; $i++) {
1349
        
cleanup
Yuki Kimoto authored on 2011-04-02
1350
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1351
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1352
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1353
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1354
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1355
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1356
            my $table1 = $1;
1357
            my $table2 = $2;
cleanup
Yuki Kimoto authored on 2011-04-25
1358
            croak qq{right side table of "$join_clause" must be unique }
1359
                . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1360
              if exists $tree->{$table2};
1361
            $tree->{$table2}
1362
              = {position => $i, parent => $table1, join => $join_clause};
1363
        }
1364
        else {
improved error message
Yuki Kimoto authored on 2011-06-13
1365
            croak qq{join clause must have two table name after "on" keyword. } .
1366
                  qq{"$join_clause" is passed }  . _subname
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1367
        }
1368
    }
1369
    
cleanup
Yuki Kimoto authored on 2011-04-02
1370
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1371
    my $need_tables = {};
1372
    $self->_need_tables($tree, $need_tables, $join_tables);
1373
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1374
    
1375
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1376
    foreach my $need_table (@need_tables) {
1377
        push @$sql, $tree->{$need_table}{join};
1378
    }
1379
}
cleanup
Yuki Kimoto authored on 2011-03-08
1380

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1381
sub _quote {
1382
    my $self = shift;
1383
    
1384
    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1385
         : defined $self->quote ? $self->quote
1386
         : '';
1387
}
1388

            
cleanup
Yuki Kimoto authored on 2011-04-02
1389
sub _remove_duplicate_table {
1390
    my ($self, $tables, $main_table) = @_;
1391
    
1392
    # Remove duplicate table
1393
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1394
    delete $tables{$main_table} if $main_table;
1395
    
1396
    return [keys %tables, $main_table ? $main_table : ()];
1397
}
1398

            
cleanup
Yuki Kimoto authored on 2011-04-02
1399
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1400
    my ($self, $source) = @_;
1401
    
cleanup
Yuki Kimoto authored on 2011-04-02
1402
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1403
    my $tables = [];
1404
    my $safety_character = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1405
    my $q = $self->_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
1406
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1407
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1408
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1409
    while ($source =~ /$table_re/g) {
1410
        push @$tables, $1;
1411
    }
1412
    
1413
    return $tables;
1414
}
1415

            
cleanup
Yuki Kimoto authored on 2011-04-02
1416
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1417
    my ($self, $where) = @_;
1418
    
cleanup
Yuki Kimoto authored on 2011-04-02
1419
    my $obj;
1420
    
1421
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1422
    if (ref $where eq 'HASH') {
1423
        my $clause = ['and'];
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1424
        my $q = $self->_quote;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1425
        foreach my $column (keys %$where) {
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1426
            my $column_quote = "$q$column$q";
1427
            $column_quote =~ s/\./$q.$q/;
1428
            push @$clause, "$column_quote = :$column" for keys %$where;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1429
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1430
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1431
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1432
    
1433
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1434
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1435
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1436
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1437
    
updated pod
Yuki Kimoto authored on 2011-06-21
1438
    # Array
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1439
    elsif (ref $where eq 'ARRAY') {
cleanup
Yuki Kimoto authored on 2011-04-02
1440
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1441
            clause => $where->[0],
1442
            param  => $where->[1]
1443
        );
1444
    }
1445
    
cleanup
Yuki Kimoto authored on 2011-04-02
1446
    # Check where argument
improved error messages
Yuki Kimoto authored on 2011-04-18
1447
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
1448
        . qq{or array reference, which contains where clause and parameter}
cleanup
Yuki Kimoto authored on 2011-04-25
1449
        . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1450
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1451
    
cleanup
Yuki Kimoto authored on 2011-04-02
1452
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1453
}
1454

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

            
1458
    # Initialize filters
1459
    $self->{filter} ||= {};
1460
    $self->{filter}{out} ||= {};
1461
    $self->{filter}{in} ||= {};
1462
    $self->{filter}{end} ||= {};
1463
    
1464
    # Usage
1465
    my $usage = "Usage: \$dbi->apply_filter(" .
1466
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1467
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1468
    
1469
    # Apply filter
1470
    for (my $i = 0; $i < @cinfos; $i += 2) {
1471
        
1472
        # Column
1473
        my $column = $cinfos[$i];
1474
        if (ref $column eq 'ARRAY') {
1475
            foreach my $c (@$column) {
1476
                push @cinfos, $c, $cinfos[$i + 1];
1477
            }
1478
            next;
1479
        }
1480
        
1481
        # Filter infomation
1482
        my $finfo = $cinfos[$i + 1] || {};
1483
        croak "$usage (table: $table) " . _subname
1484
          unless  ref $finfo eq 'HASH';
1485
        foreach my $ftype (keys %$finfo) {
1486
            croak "$usage (table: $table) " . _subname
1487
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1488
        }
1489
        
1490
        # Set filters
1491
        foreach my $way (qw/in out end/) {
1492
        
1493
            # Filter
1494
            my $filter = $finfo->{$way};
1495
            
1496
            # Filter state
1497
            my $state = !exists $finfo->{$way} ? 'not_exists'
1498
                      : !defined $filter        ? 'not_defined'
1499
                      : ref $filter eq 'CODE'   ? 'code'
1500
                      : 'name';
1501
            
1502
            # Filter is not exists
1503
            next if $state eq 'not_exists';
1504
            
1505
            # Check filter name
1506
            croak qq{Filter "$filter" is not registered } . _subname
1507
              if  $state eq 'name'
1508
               && ! exists $self->filters->{$filter};
1509
            
1510
            # Set filter
1511
            my $f = $state eq 'not_defined' ? undef
1512
                  : $state eq 'code'        ? $filter
1513
                  : $self->filters->{$filter};
1514
            $self->{filter}{$way}{$table}{$column} = $f;
1515
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1516
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1517
            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1518
        }
1519
    }
1520
    
1521
    return $self;
1522
}
1523

            
1524
# DEPRECATED!
1525
sub create_query {
1526
    warn "create_query is DEPRECATED! use query option of each method";
1527
    shift->_create_query(@_);
1528
}
1529

            
cleanup
Yuki Kimoto authored on 2011-06-13
1530
# DEPRECATED!
1531
sub apply_filter {
1532
    my $self = shift;
1533
    
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1534
    warn "apply_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-06-13
1535
    return $self->_apply_filter(@_);
1536
}
1537

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1538
# DEPRECATED!
1539
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
1540
sub select_at {
1541
    my ($self, %args) = @_;
1542

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1545
    # Arguments
1546
    my $primary_keys = delete $args{primary_key};
1547
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1548
    my $where = delete $args{where};
1549
    my $param = delete $args{param};
1550
    
1551
    # Check arguments
1552
    foreach my $name (keys %args) {
1553
        croak qq{"$name" is wrong option } . _subname
1554
          unless $SELECT_AT_ARGS{$name};
1555
    }
1556
    
1557
    # Table
1558
    croak qq{"table" option must be specified } . _subname
1559
      unless $args{table};
1560
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1561
    
1562
    # Create where parameter
1563
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1564
    
1565
    return $self->select(where => $where_param, %args);
1566
}
1567

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1568
# DEPRECATED!
1569
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
1570
sub delete_at {
1571
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1572

            
1573
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1574
    
1575
    # Arguments
1576
    my $primary_keys = delete $args{primary_key};
1577
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1578
    my $where = delete $args{where};
1579
    
1580
    # Check arguments
1581
    foreach my $name (keys %args) {
1582
        croak qq{"$name" is wrong option } . _subname
1583
          unless $DELETE_AT_ARGS{$name};
1584
    }
1585
    
1586
    # Create where parameter
1587
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1588
    
1589
    return $self->delete(where => $where_param, %args);
1590
}
1591

            
cleanup
Yuki Kimoto authored on 2011-06-08
1592
# DEPRECATED!
1593
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
1594
sub update_at {
1595
    my $self = shift;
1596

            
1597
    warn "update_at is DEPRECATED! use update and id option instead";
1598
    
1599
    # Arguments
1600
    my $param;
1601
    $param = shift if @_ % 2;
1602
    my %args = @_;
1603
    my $primary_keys = delete $args{primary_key};
1604
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1605
    my $where = delete $args{where};
1606
    my $p = delete $args{param} || {};
1607
    $param  ||= $p;
1608
    
1609
    # Check arguments
1610
    foreach my $name (keys %args) {
1611
        croak qq{"$name" is wrong option } . _subname
1612
          unless $UPDATE_AT_ARGS{$name};
1613
    }
1614
    
1615
    # Create where parameter
1616
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1617
    
1618
    return $self->update(where => $where_param, param => $param, %args);
1619
}
1620

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1621
# DEPRECATED!
1622
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
1623
sub insert_at {
1624
    my $self = shift;
1625
    
1626
    warn "insert_at is DEPRECATED! use insert and id option instead";
1627
    
1628
    # Arguments
1629
    my $param;
1630
    $param = shift if @_ % 2;
1631
    my %args = @_;
1632
    my $primary_key = delete $args{primary_key};
1633
    $primary_key = [$primary_key] unless ref $primary_key;
1634
    my $where = delete $args{where};
1635
    my $p = delete $args{param} || {};
1636
    $param  ||= $p;
1637
    
1638
    # Check arguments
1639
    foreach my $name (keys %args) {
1640
        croak qq{"$name" is wrong option } . _subname
1641
          unless $INSERT_AT_ARGS{$name};
1642
    }
1643
    
1644
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1645
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1646
    $param = $self->merge_param($where_param, $param);
1647
    
1648
    return $self->insert(param => $param, %args);
1649
}
1650

            
added warnings
Yuki Kimoto authored on 2011-06-07
1651
# DEPRECATED!
1652
sub register_tag {
1653
    warn "register_tag is DEPRECATED!";
1654
    shift->query_builder->register_tag(@_)
1655
}
1656

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1657
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-06-13
1658
has 'data_source';
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1659
has dbi_options => sub { {} };
1660
has filter_check  => 1;
1661
has 'reserved_word_quote';
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1662

            
cleanup
Yuki Kimoto authored on 2011-01-25
1663
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1664
sub default_bind_filter {
1665
    my $self = shift;
1666
    
cleanup
Yuki Kimoto authored on 2011-06-13
1667
    warn "default_bind_filter is DEPRECATED!";
added warnings
Yuki Kimoto authored on 2011-06-07
1668
    
cleanup
Yuki Kimoto authored on 2011-01-12
1669
    if (@_) {
1670
        my $fname = $_[0];
1671
        
1672
        if (@_ && !$fname) {
1673
            $self->{default_out_filter} = undef;
1674
        }
1675
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1676
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1677
              unless exists $self->filters->{$fname};
1678
        
1679
            $self->{default_out_filter} = $self->filters->{$fname};
1680
        }
1681
        return $self;
1682
    }
1683
    
1684
    return $self->{default_out_filter};
1685
}
1686

            
cleanup
Yuki Kimoto authored on 2011-01-25
1687
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1688
sub default_fetch_filter {
1689
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1690

            
cleanup
Yuki Kimoto authored on 2011-06-13
1691
    warn "default_fetch_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-01-12
1692
    
1693
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1694
        my $fname = $_[0];
1695

            
cleanup
Yuki Kimoto authored on 2011-01-12
1696
        if (@_ && !$fname) {
1697
            $self->{default_in_filter} = undef;
1698
        }
1699
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1700
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1701
              unless exists $self->filters->{$fname};
1702
        
1703
            $self->{default_in_filter} = $self->filters->{$fname};
1704
        }
1705
        
1706
        return $self;
1707
    }
1708
    
many changed
Yuki Kimoto authored on 2011-01-23
1709
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1710
}
1711

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1712
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1713
sub insert_param_tag {
1714
    warn "insert_param_tag is DEPRECATED! " .
1715
         "use insert_param instead!";
1716
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1717
}
1718

            
cleanup
Yuki Kimoto authored on 2011-01-25
1719
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1720
sub register_tag_processor {
added warnings
Yuki Kimoto authored on 2011-06-07
1721
    warn "register_tag_processor is DEPRECATED!";
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1722
    return shift->query_builder->register_tag_processor(@_);
1723
}
1724

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1725
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1726
sub update_param_tag {
fixed DEPRECATED message bug
Yuki Kimoto authored on 2011-06-10
1727
    warn "update_param_tag is DEPRECATED! " .
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1728
         "use update_param instead";
1729
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1730
}
cleanup
Yuki Kimoto authored on 2011-03-08
1731
# DEPRECATED!
1732
sub _push_relation {
1733
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1734
    
1735
    if (keys %{$relation || {}}) {
1736
        push @$sql, $need_where ? 'where' : 'and';
1737
        foreach my $rcolumn (keys %$relation) {
1738
            my $table1 = (split (/\./, $rcolumn))[0];
1739
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1740
            push @$tables, ($table1, $table2);
1741
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1742
        }
1743
    }
1744
    pop @$sql if $sql->[-1] eq 'and';    
1745
}
1746

            
1747
# DEPRECATED!
1748
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1749
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1750
    
1751
    if (keys %{$relation || {}}) {
1752
        foreach my $rcolumn (keys %$relation) {
1753
            my $table1 = (split (/\./, $rcolumn))[0];
1754
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1755
            my $table1_exists;
1756
            my $table2_exists;
1757
            foreach my $table (@$tables) {
1758
                $table1_exists = 1 if $table eq $table1;
1759
                $table2_exists = 1 if $table eq $table2;
1760
            }
1761
            unshift @$tables, $table1 unless $table1_exists;
1762
            unshift @$tables, $table2 unless $table2_exists;
1763
        }
1764
    }
1765
}
1766

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1769
=head1 NAME
1770

            
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1771
DBIx::Custom - Execute insert, update, delete, and select statement easily
removed reconnect method
yuki-kimoto authored on 2010-05-28
1772

            
1773
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1774

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1775
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1776
    
1777
    # Connect
1778
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1779
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1780
        user => 'ken',
1781
        password => '!LFKD%$&',
1782
        dbi_option => {mysql_enable_utf8 => 1}
1783
    );
cleanup
yuki-kimoto authored on 2010-08-05
1784

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1785
    # Insert 
updated pod
Yuki Kimoto authored on 2011-06-21
1786
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
removed reconnect method
yuki-kimoto authored on 2010-05-28
1787
    
1788
    # Update 
updated pod
Yuki Kimoto authored on 2011-06-21
1789
    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1790
      where  => {id => 5});
removed reconnect method
yuki-kimoto authored on 2010-05-28
1791
    
1792
    # Delete
updated pod
Yuki Kimoto authored on 2011-06-21
1793
    $dbi->delete(table  => 'book', where => {author => 'Ken'});
cleanup
yuki-kimoto authored on 2010-08-05
1794

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1799
    # Select, more complex
1800
    my $result = $dbi->select(
1801
        table  => 'book',
1802
        column => [
cleanup
Yuki Kimoto authored on 2011-06-13
1803
            {book => [qw/title author/]},
1804
            {company => ['name']}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1805
        ],
1806
        where  => {'book.author' => 'Ken'},
1807
        join => ['left outer join company on book.company_id = company.id'],
1808
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1809
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1810
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1811
    # Fetch
1812
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1813
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1814
    }
1815
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1816
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1817
    while (my $row = $result->fetch_hash) {
1818
        
1819
    }
1820
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1821
    # Execute SQL with parameter.
1822
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1823
        "select id from book where author = :author and title like :title",
updated pod
Yuki Kimoto authored on 2011-06-21
1824
        {author => 'ken', title => '%Perl%'}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1825
    );
1826
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1827
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1828

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

            
1831
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1832

            
updated pod
Yuki Kimoto authored on 2011-06-21
1833
L<DBIx::Custom> is the wrapper class of L<DBI> to execute SQL easily.
1834
This module have the following features.
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1835

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
1838
=item * Execute INSERT, UPDATE, DELETE, SELECT statement easily
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1839

            
updated pod
Yuki Kimoto authored on 2011-06-21
1840
=item * You can specify bind values by hash reference
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1841

            
updated pod
Yuki Kimoto authored on 2011-06-21
1842
=item * Filtering by data type. and you can set filter to any column
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1843

            
updated pod
Yuki Kimoto authored on 2011-06-21
1844
=item * Creating where clause flexibly
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1845

            
updated pod
Yuki Kimoto authored on 2011-06-21
1846
=item * Support model
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1847

            
1848
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1849

            
1850
=head1 GUIDE
1851

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

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

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

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

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

            
1862
    my $connector = $dbi->connector;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1863
    $dbi = $dbi->connector(DBIx::Connector->new(...));
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1864

            
updated pod
Yuki Kimoto authored on 2011-06-21
1865
Connection manager object. if connector is set, you can get C<dbh>
1866
through connection manager. conection manager object must have C<dbh> mehtod.
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1867

            
1868
This is L<DBIx::Connector> example. Please pass
updated pod
Yuki Kimoto authored on 2011-06-21
1869
C<default_dbi_option> to L<DBIx::Connector> C<new> method.
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1870

            
1871
    my $connector = DBIx::Connector->new(
1872
        "dbi:mysql:database=$DATABASE",
1873
        $USER,
1874
        $PASSWORD,
1875
        DBIx::Custom->new->default_dbi_option
1876
    );
1877
    
updated pod
Yuki Kimoto authored on 2011-06-21
1878
    my $dbi = DBIx::Custom->connect(connector => $connector);
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1879

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

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

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

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

            
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1889
    my $dbi_option = $dbi->dbi_option;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1890
    $dbi = $dbi->dbi_option($dbi_option);
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1891

            
updated pod
Yuki Kimoto authored on 2011-06-21
1892
L<DBI> option, used when C<connect> method is executed.
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1893
Each value in option override the value of C<default_dbi_option>.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1894

            
1895
=head2 C<default_dbi_option>
1896

            
1897
    my $default_dbi_option = $dbi->default_dbi_option;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1898
    $dbi = $dbi->default_dbi_option($default_dbi_option);
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1899

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1903
    {
1904
        RaiseError => 1,
1905
        PrintError => 0,
1906
        AutoCommit => 1,
1907
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1908

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

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

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

            
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
1916
=head2 C<last_sql> EXPERIMENTAL
1917

            
1918
    my $last_sql = $dbi->last_sql;
1919
    $dbi = $dbi->last_sql($last_sql);
1920

            
1921
Get last successed SQL executed by C<execute> method.
1922

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1930
=head2 C<password>
1931

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

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

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

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1939
    my $sql_class = $dbi->query_builder;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1940
    $dbi = $dbi->query_builder(DBIx::Custom::QueryBuilder->new);
added commit method
yuki-kimoto authored on 2010-05-27
1941

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

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

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

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

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

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1962
    my $safety_character = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1963
    $dbi = $self->safety_character($character);
update pod
Yuki Kimoto authored on 2011-01-27
1964

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

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

            
1970
    my $tag_parse = $dbi->tag_parse(0);
1971
    $dbi = $dbi->tag_parse;
1972

            
1973
Enable DEPRECATED tag parsing functionality, default to 1.
1974
If you want to disable tag parsing functionality, set to 0.
1975

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

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

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

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

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

            
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1989
=head2 C<available_data_type> EXPERIMENTAL
1990

            
1991
    print $dbi->available_data_type;
1992

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

            
1996
=head2 C<available_type_name> EXPERIMENTAL
1997

            
1998
    print $dbi->available_type_name;
1999

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

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-09
2007
Create assign parameter.
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
2008

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

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
2013
=head2 C<column> EXPERIMETNAL
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2014

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

            
2017
Create column clause. The follwoing column clause is created.
2018

            
2019
    book.author as "book.author",
2020
    book.title as "book.title"
2021

            
cleanup
Yuki Kimoto authored on 2011-06-13
2022
You can change separator by C<separator> method.
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2023

            
cleanup
Yuki Kimoto authored on 2011-06-13
2024
    # Separator is double underbar
2025
    $dbi->separator('__');
2026
    
2027
    book.author as "book__author",
2028
    book.title as "book__title"
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2029

            
cleanup
Yuki Kimoto authored on 2011-06-13
2030
    # Separator is hyphen
2031
    $dbi->separator('-');
2032
    
2033
    book.author as "book-author",
2034
    book.title as "book-title"
2035
    
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2036
=head2 C<connect>
packaging one directory
yuki-kimoto authored on 2009-11-16
2037

            
update pod
Yuki Kimoto authored on 2011-03-13
2038
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2039
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2040
        user => 'ken',
2041
        password => '!LFKD%$&',
2042
        dbi_option => {mysql_enable_utf8 => 1}
2043
    );
2044

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
2053
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2054
        table => 'book',
2055
        primary_key => 'id',
2056
        join => [
2057
            'inner join company on book.comparny_id = company.id'
2058
        ],
2059
    );
2060

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

            
2064
   $dbi->model('book')->select(...);
2065

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

            
2068
    my $dbh = $dbi->dbh;
2069

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

            
2073
=head2 C<each_column>
2074

            
2075
    $dbi->each_column(
2076
        sub {
2077
            my ($dbi, $table, $column, $column_info) = @_;
2078
            
2079
            my $type = $column_info->{TYPE_NAME};
2080
            
2081
            if ($type eq 'DATE') {
2082
                # ...
2083
            }
2084
        }
2085
    );
2086

            
2087
Iterate all column informations of all table from database.
2088
Argument is callback when one column is found.
2089
Callback receive four arguments, dbi object, table name,
2090
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
2091

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
2092
=head2 C<each_table> EXPERIMENTAL
2093

            
2094
    $dbi->each_table(
2095
        sub {
2096
            my ($dbi, $table, $table_info) = @_;
2097
            
2098
            my $table_name = $table_info->{TABLE_NAME};
2099
        }
2100
    );
2101

            
2102
Iterate all table informationsfrom database.
2103
Argument is callback when one table is found.
2104
Callback receive three arguments, dbi object, table name,
2105
table information.
2106

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

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

            
2114
    my $result = $dbi->execute(
2115
      "select * from book where title = :book.title and author like :book.author",
2116
      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
update pod
Yuki Kimoto authored on 2011-03-13
2117
    );
2118

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

            
updated pod
Yuki Kimoto authored on 2011-06-09
2125
Parameter is replaced by placeholder C<?>.
update pod
Yuki Kimoto authored on 2011-03-13
2126

            
2127
    select * from where title = ? and author like ?;
2128

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

            
2131
=over 4
2132

            
2133
=item C<filter>
updated pod
Yuki Kimoto authored on 2011-06-09
2134
    
2135
    filter => {
2136
        title  => sub { uc $_[0] }
2137
        author => sub { uc $_[0] }
2138
    }
update pod
Yuki Kimoto authored on 2011-03-13
2139

            
updated pod
Yuki Kimoto authored on 2011-06-09
2140
    # Filter name
2141
    filter => {
2142
        title  => 'upper_case',
2143
        author => 'upper_case'
2144
    }
2145
        
2146
    # At once
2147
    filter => [
2148
        [qw/title author/]  => sub { uc $_[0] }
2149
    ]
2150

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

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

            
2158
    query => 1
2159

            
2160
C<execute> method return L<DBIx::Custom::Query> object, not executing SQL.
updated pod
Yuki Kimoto authored on 2011-06-21
2161
You can check executed SQL and columns order.
2162

            
2163
    my $sql = $query->sql;
2164
    my $columns = $query->columns;
updated document
Yuki Kimoto authored on 2011-06-09
2165

            
updated pod
Yuki Kimoto authored on 2011-06-09
2166
=item C<table>
2167
    
2168
    table => 'author'
2169

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2177
    # Same
2178
    $dbi->execute(
2179
      "select * from book where title = :book.title and author = :book.author",
2180
      {title => 'Perl', author => 'Ken');
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2181

            
updated pod
Yuki Kimoto authored on 2011-06-21
2182
=item C<bind_type>
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2183

            
updated pod
Yuki Kimoto authored on 2011-06-21
2184
Specify database bind data type.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2185

            
updated pod
Yuki Kimoto authored on 2011-06-21
2186
    bind_type => [image => DBI::SQL_BLOB]
2187
    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2188

            
updated pod
Yuki Kimoto authored on 2011-06-21
2189
This is used to bind parameter by C<bind_param> of statment handle.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2190

            
updated pod
Yuki Kimoto authored on 2011-06-21
2191
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2192

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
2193
=item C<table_alias> EXPERIMENTAL
2194

            
2195
    table_alias => {user => 'hiker'}
2196

            
2197
Table alias. Key is real table name, value is alias table name.
2198
If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2199
on alias table name.
2200

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2201
=item C<type_rule_off> EXPERIMENTAL
2202

            
2203
    type_rule_off => 1
2204

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

            
2207
=item C<type_rule1_off> EXPERIMENTAL
2208

            
2209
    type_rule1_off => 1
2210

            
2211
Turn C<into1> type rule off.
2212

            
2213
=item C<type_rule2_off> EXPERIMENTAL
2214

            
2215
    type_rule2_off => 1
2216

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

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

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2225
Execute delete statement.
update pod
Yuki Kimoto authored on 2011-03-13
2226

            
updated document
Yuki Kimoto authored on 2011-06-09
2227
The following opitons are available.
update pod
Yuki Kimoto authored on 2011-03-13
2228

            
update pod
Yuki Kimoto authored on 2011-03-13
2229
=over 4
2230

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2233
Same as C<select> method's C<append> option.
update pod
Yuki Kimoto authored on 2011-03-13
2234

            
2235
=item C<filter>
2236

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2237
Same as C<execute> method's C<filter> option.
update pod
Yuki Kimoto authored on 2011-03-13
2238

            
updated document
Yuki Kimoto authored on 2011-06-09
2239
=item C<id>
update pod
Yuki Kimoto authored on 2011-03-13
2240

            
updated document
Yuki Kimoto authored on 2011-06-09
2241
    id => 4
2242
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2243

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2247
    $dbi->delete(
2248
        parimary_key => ['id1', 'id2'],
2249
        id => [4, 5],
2250
        table => 'book',
2251
    );
update pod
Yuki Kimoto authored on 2011-03-13
2252

            
updated document
Yuki Kimoto authored on 2011-06-09
2253
The above is same as the followin one.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2254

            
updated document
Yuki Kimoto authored on 2011-06-09
2255
    $dbi->delete(where => {id1 => 4, id2 => 5}, table => 'book');
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2256

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
2257
=item C<prefix> EXPERIMENTAL
2258

            
2259
    prefix => 'some'
2260

            
2261
prefix before table name section.
2262

            
2263
    delete some from book
2264

            
updated document
Yuki Kimoto authored on 2011-06-09
2265
=item C<query>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2266

            
updated document
Yuki Kimoto authored on 2011-06-09
2267
Same as C<execute> method's C<query> option.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2268

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2273
Table name.
2274

            
updated document
Yuki Kimoto authored on 2011-06-09
2275
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2276

            
updated document
Yuki Kimoto authored on 2011-06-09
2277
Same as C<select> method's C<where> option.
update pod
Yuki Kimoto authored on 2011-03-13
2278

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2283
=item C<bind_type>
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2284

            
updated pod
Yuki Kimoto authored on 2011-06-21
2285
Same as C<execute> method's C<bind_type> option.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2286

            
2287
=item C<type_rule_off> EXPERIMENTAL
2288

            
2289
Same as C<execute> method's C<type_rule_off> option.
2290

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2291
=item C<type_rule1_off> EXPERIMENTAL
2292

            
2293
    type_rule1_off => 1
2294

            
2295
Same as C<execute> method's C<type_rule1_off> option.
2296

            
2297
=item C<type_rule2_off> EXPERIMENTAL
2298

            
2299
    type_rule2_off => 1
2300

            
2301
Same as C<execute> method's C<type_rule2_off> option.
2302

            
updated pod
Yuki Kimoto authored on 2011-06-08
2303
=back
update pod
Yuki Kimoto authored on 2011-03-13
2304

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2309
Execute delete statement for all rows.
updated pod
Yuki Kimoto authored on 2011-06-21
2310
Options is same as C<delete>.
update pod
Yuki Kimoto authored on 2011-03-13
2311

            
cleanup
yuki-kimoto authored on 2010-10-17
2312
=head2 C<insert>
2313

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

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

            
cleanup
Yuki Kimoto authored on 2011-06-09
2319
The following opitons are available.
update pod
Yuki Kimoto authored on 2011-03-13
2320

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

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

            
cleanup
Yuki Kimoto authored on 2011-06-09
2325
Same as C<select> method's C<append> option.
update pod
Yuki Kimoto authored on 2011-03-13
2326

            
2327
=item C<filter>
2328

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2329
Same as C<execute> method's C<filter> option.
2330

            
2331
=item C<id>
2332

            
updated document
Yuki Kimoto authored on 2011-06-09
2333
    id => 4
2334
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2335

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2339
    $dbi->insert(
updated document
Yuki Kimoto authored on 2011-06-09
2340
        {title => 'Perl', author => 'Ken'}
2341
        parimary_key => ['id1', 'id2'],
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2342
        id => [4, 5],
updated document
Yuki Kimoto authored on 2011-06-09
2343
        table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2344
    );
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2345

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

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

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
2353
=item C<prefix> EXPERIMENTAL
2354

            
2355
    prefix => 'or replace'
2356

            
2357
prefix before table name section
2358

            
2359
    insert or replace into book
2360

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2361
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2362

            
updated document
Yuki Kimoto authored on 2011-06-09
2363
    primary_key => 'id'
2364
    primary_key => ['id1', 'id2']
update pod
Yuki Kimoto authored on 2011-03-13
2365

            
updated document
Yuki Kimoto authored on 2011-06-09
2366
Primary key. This is used by C<id> option.
cleanup
Yuki Kimoto authored on 2011-06-09
2367

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

            
2370
Same as C<execute> method's C<query> option.
2371

            
2372
=item C<table>
2373

            
2374
    table => 'book'
2375

            
2376
Table name.
2377

            
updated pod
Yuki Kimoto authored on 2011-06-21
2378
=item C<bind_type>
cleanup
yuki-kimoto authored on 2010-10-17
2379

            
updated pod
Yuki Kimoto authored on 2011-06-21
2380
Same as C<execute> method's C<bind_type> option.
cleanup
yuki-kimoto authored on 2010-10-17
2381

            
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2382
=item C<type_rule_off> EXPERIMENTAL
2383

            
updated document
Yuki Kimoto authored on 2011-06-09
2384
Same as C<execute> method's C<type_rule_off> option.
update pod
Yuki Kimoto authored on 2011-03-13
2385

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2386
=item C<type_rule1_off> EXPERIMENTAL
2387

            
2388
    type_rule1_off => 1
2389

            
2390
Same as C<execute> method's C<type_rule1_off> option.
2391

            
2392
=item C<type_rule2_off> EXPERIMENTAL
2393

            
2394
    type_rule2_off => 1
2395

            
2396
Same as C<execute> method's C<type_rule2_off> option.
2397

            
update pod
Yuki Kimoto authored on 2011-03-13
2398
=back
2399

            
2400
=over 4
2401

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2417
    lib / MyModel.pm
2418
        / MyModel / book.pm
2419
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2420

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

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

            
2425
    package MyModel;
updated pod
Yuki Kimoto authored on 2011-06-21
2426
    use DBIx::Custom::Model -base;
update pod
Yuki Kimoto authored on 2011-03-13
2427
    
2428
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2429

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2434
    package MyModel::book;
updated pod
Yuki Kimoto authored on 2011-06-21
2435
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2436
    
2437
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2438

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2441
    package MyModel::company;
updated pod
Yuki Kimoto authored on 2011-06-21
2442
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2443
    
2444
    1;
2445
    
updated pod
Yuki Kimoto authored on 2011-06-21
2446
MyModel::book and MyModel::company is included by C<include_model>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2447

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

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

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

            
added EXPERIMENTAL map_param...
Yuki Kimoto authored on 2011-06-24
2455
=head2 C<map_param> EXPERIMENTAL
2456

            
2457
    my $map_param = $dbi->map_param(
2458
        {id => 1, authro => 'Ken', price => 1900},
2459
        'id' => 'book.id',
2460
        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2461
        'price' => [
2462
            'book.price', {if => sub { length $_[0] }}
2463
        ]
2464
    );
2465

            
2466
Map paramters to other key and value. First argument is original
2467
parameter. this is hash reference. Rest argument is mapping.
2468
By default, Mapping is done if the value length is not zero.
2469

            
2470
=over 4
2471

            
2472
=item Key mapping
2473

            
2474
    'id' => 'book.id'
2475

            
2476
This is only key mapping. Value is same as original one.
2477

            
2478
    (id => 1) is mapped to ('book.id' => 1) if value length is not zero.
2479

            
2480
=item Key and value mapping
2481

            
2482
    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2483

            
2484
This is key and value mapping. Frist element of array reference
2485
is mapped key name, second element is code reference to map the value.
2486

            
2487
    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2488
      if value length is not zero.
2489

            
2490
=item Condition
2491

            
2492
    'price' => ['book.price', {if => 'exists'}]
2493
    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2494
    'price' => ['book.price', {if => sub { defined shift }}]
2495

            
2496
If you need condition, you can sepecify it. this is code reference
2497
or 'exists'. By default, condition is the following one.
2498

            
2499
    sub { defined $_[0] && length $_[0] }
2500

            
2501
=back
2502

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

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

            
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
2507
Merge parameters.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2508

            
2509
    {key1 => [1, 1], key2 => 2}
2510

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

            
2513
    $dbi->method(
2514
        update_or_insert => sub {
2515
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2516
            
2517
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2518
        },
2519
        find_or_create   => sub {
2520
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2521
            
2522
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2523
        }
2524
    );
2525

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

            
2528
    $dbi->update_or_insert;
2529
    $dbi->find_or_create;
2530

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

            
2533
    my $model = $dbi->model('book');
2534

            
updated pod
Yuki Kimoto authored on 2011-06-21
2535
Get a L<DBIx::Custom::Model> object,
update pod
Yuki Kimoto authored on 2011-03-13
2536

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

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

            
2541
Create column clause for myself. The follwoing column clause is created.
2542

            
2543
    book.author as author,
2544
    book.title as title
2545

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2548
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2549
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2550
        user => 'ken',
2551
        password => '!LFKD%$&',
2552
        dbi_option => {mysql_enable_utf8 => 1}
2553
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2554

            
2555
Create a new L<DBIx::Custom> object.
2556

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

            
2559
    my $not_exists = $dbi->not_exists;
2560

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

            
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
2564
=head2 C<order> EXPERIMENTAL
2565

            
2566
    my $order = $dbi->order;
2567

            
2568
Create a new L<DBIx::Custom::Order> object.
2569

            
cleanup
yuki-kimoto authored on 2010-10-17
2570
=head2 C<register_filter>
2571

            
update pod
Yuki Kimoto authored on 2011-03-13
2572
    $dbi->register_filter(
2573
        # Time::Piece object to database DATE format
2574
        tp_to_date => sub {
2575
            my $tp = shift;
2576
            return $tp->strftime('%Y-%m-%d');
2577
        },
2578
        # database DATE format to Time::Piece object
2579
        date_to_tp => sub {
2580
           my $date = shift;
2581
           return Time::Piece->strptime($date, '%Y-%m-%d');
2582
        }
2583
    );
cleanup
yuki-kimoto authored on 2010-10-17
2584
    
update pod
Yuki Kimoto authored on 2011-03-13
2585
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2586

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

            
2589
    $dbi->type_rule(
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2590
        into1 => {
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2591
            date => sub { ... },
2592
            datetime => sub { ... }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2593
        },
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2594
        into2 => {
2595
            date => sub { ... },
2596
            datetime => sub { ... }
2597
        },
2598
        from1 => {
2599
            # DATE
2600
            9 => sub { ... },
2601
            # DATETIME or TIMESTAMP
2602
            11 => sub { ... },
2603
        }
2604
        from2 => {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2605
            # DATE
2606
            9 => sub { ... },
2607
            # DATETIME or TIMESTAMP
2608
            11 => sub { ... },
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2609
        }
2610
    );
2611

            
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2612
Filtering rule when data is send into and get from database.
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2613
This has a little complex problem.
cleanup
Yuki Kimoto authored on 2011-06-13
2614

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2615
In C<into1> and C<into2> you can specify
2616
type name as same as type name defined
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2617
by create table, such as C<DATETIME> or C<DATE>.
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2618

            
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2619
Note that type name and data type don't contain upper case.
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2620
If these contain upper case charactor, you convert it to lower case.
2621

            
updated pod
Yuki Kimoto authored on 2011-06-21
2622
C<into2> is executed after C<into1>.
2623

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2624
Type rule of C<into1> and C<into2> is enabled on the following
2625
column name.
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
2626

            
cleanup
Yuki Kimoto authored on 2011-06-13
2627
=over 4
2628

            
2629
=item 1. column name
2630

            
2631
    issue_date
2632
    issue_datetime
2633

            
updated pod
Yuki Kimoto authored on 2011-06-21
2634
This need C<table> option in each method.
2635

            
cleanup
Yuki Kimoto authored on 2011-06-13
2636
=item 2. table name and column name, separator is dot
2637

            
2638
    book.issue_date
2639
    book.issue_datetime
2640

            
2641
=back
2642

            
update pod
Yuki Kimoto authored on 2011-06-15
2643
You get all type name used in database by C<available_type_name>.
2644

            
2645
    print $dbi->available_type_name;
2646

            
updated pod
Yuki Kimoto authored on 2011-06-21
2647
In C<from1> and C<from2> you specify data type, not type name.
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2648
C<from2> is executed after C<from1>.
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2649
You get all data type by C<available_data_type>.
2650

            
2651
    print $dbi->available_data_type;
2652

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2653
You can also specify multiple types at once.
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2654

            
2655
    $dbi->type_rule(
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2656
        into1 => [
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2657
            [qw/DATE DATETIME/] => sub { ... },
2658
        ],
2659
    );
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
2660

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2663
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2664
        table  => 'book',
2665
        column => ['author', 'title'],
2666
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2667
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2668
    
updated document
Yuki Kimoto authored on 2011-06-09
2669
Execute select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2670

            
updated document
Yuki Kimoto authored on 2011-06-09
2671
The following opitons are available.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2672

            
2673
=over 4
2674

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2677
    append => 'order by title'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2678

            
updated document
Yuki Kimoto authored on 2011-06-09
2679
Append statement to last of SQL.
2680
    
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2681
=item C<column>
2682
    
updated document
Yuki Kimoto authored on 2011-06-09
2683
    column => 'author'
2684
    column => ['author', 'title']
2685

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2692
You can specify hash of array reference. This is EXPERIMENTAL.
updated pod
Yuki Kimoto authored on 2011-06-07
2693

            
updated document
Yuki Kimoto authored on 2011-06-09
2694
    column => [
updated pod
Yuki Kimoto authored on 2011-06-07
2695
        {book => [qw/author title/]},
2696
        {person => [qw/name age/]}
updated document
Yuki Kimoto authored on 2011-06-09
2697
    ]
updated pod
Yuki Kimoto authored on 2011-06-07
2698

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

            
2701
    book.author as "book.author",
2702
    book.title as "book.title",
2703
    person.name as "person.name",
2704
    person.age as "person.age"
2705

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

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

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

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

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

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

            
2721
=item C<id>
2722

            
2723
    id => 4
2724
    id => [4, 5]
2725

            
2726
ID corresponding to C<primary_key>.
2727
You can select rows by C<id> and C<primary_key>.
2728

            
2729
    $dbi->select(
2730
        parimary_key => ['id1', 'id2'],
2731
        id => [4, 5],
2732
        table => 'book'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2733
    );
2734

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
2737
    $dbi->select(
updated document
Yuki Kimoto authored on 2011-06-09
2738
        where => {id1 => 4, id2 => 5},
2739
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2740
    );
2741
    
updated document
Yuki Kimoto authored on 2011-06-09
2742
=item C<param> EXPERIMETNAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2743

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

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

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

            
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
2754
=itme C<prefix> EXPERIMENTAL
2755

            
2756
    prefix => 'SQL_CALC_FOUND_ROWS'
2757

            
2758
Prefix of column cluase
2759

            
2760
    select SQL_CALC_FOUND_ROWS title, author from book;
2761

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

            
2764
    join => [
2765
        'left outer join company on book.company_id = company_id',
2766
        'left outer join location on company.location_id = location.id'
2767
    ]
2768
        
2769
Join clause. If column cluase or where clause contain table name like "company.name",
2770
join clausees needed when SQL is created is used automatically.
update pod
Yuki Kimoto authored on 2011-03-12
2771

            
2772
    $dbi->select(
2773
        table => 'book',
cleanup
Yuki Kimoto authored on 2011-06-13
2774
        column => ['company.location_id as location_id'],
update pod
Yuki Kimoto authored on 2011-03-12
2775
        where => {'company.name' => 'Orange'},
2776
        join => [
2777
            'left outer join company on book.company_id = company.id',
2778
            'left outer join location on company.location_id = location.id'
2779
        ]
2780
    );
2781

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
2785
    select company.location_id as location_id
update pod
Yuki Kimoto authored on 2011-03-12
2786
    from book
2787
      left outer join company on book.company_id = company.id
cleanup
Yuki Kimoto authored on 2011-06-13
2788
    where company.name = ?;
update pod
Yuki Kimoto authored on 2011-03-12
2789

            
updated document
Yuki Kimoto authored on 2011-06-09
2790
=item C<primary_key>
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2791

            
updated document
Yuki Kimoto authored on 2011-06-09
2792
    primary_key => 'id'
2793
    primary_key => ['id1', 'id2']
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2794

            
updated document
Yuki Kimoto authored on 2011-06-09
2795
Primary key. This is used by C<id> option.
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2796

            
updated document
Yuki Kimoto authored on 2011-06-09
2797
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-12
2798

            
updated document
Yuki Kimoto authored on 2011-06-09
2799
Same as C<execute> method's C<query> option.
update pod
Yuki Kimoto authored on 2011-03-12
2800

            
updated pod
Yuki Kimoto authored on 2011-06-21
2801
=item C<bind_type>
updated pod
Yuki Kimoto authored on 2011-06-08
2802

            
updated document
Yuki Kimoto authored on 2011-06-09
2803
Same as C<execute> method's C<type> option.
updated pod
Yuki Kimoto authored on 2011-06-08
2804

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2809
Table name.
updated pod
Yuki Kimoto authored on 2011-06-08
2810

            
updated document
Yuki Kimoto authored on 2011-06-09
2811
=item C<type_rule_off> EXPERIMENTAL
updated pod
Yuki Kimoto authored on 2011-06-08
2812

            
updated document
Yuki Kimoto authored on 2011-06-09
2813
Same as C<execute> method's C<type_rule_off> option.
updated pod
Yuki Kimoto authored on 2011-06-08
2814

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2815
=item C<type_rule1_off> EXPERIMENTAL
2816

            
2817
    type_rule1_off => 1
2818

            
2819
Same as C<execute> method's C<type_rule1_off> option.
2820

            
2821
=item C<type_rule2_off> EXPERIMENTAL
2822

            
2823
    type_rule2_off => 1
2824

            
2825
Same as C<execute> method's C<type_rule2_off> option.
2826

            
updated document
Yuki Kimoto authored on 2011-06-09
2827
=item C<where>
2828
    
2829
    # Hash refrence
2830
    where => {author => 'Ken', 'title' => 'Perl'}
2831
    
2832
    # DBIx::Custom::Where object
2833
    where => $dbi->where(
2834
        clause => ['and', 'author = :author', 'title like :title'],
2835
        param  => {author => 'Ken', title => '%Perl%'}
2836
    );
updated pod
Yuki Kimoto authored on 2011-06-21
2837
    
2838
    # Array reference 1 (array reference, hash referenc). same as above
2839
    where => [
2840
        ['and', 'author = :author', 'title like :title'],
2841
        {author => 'Ken', title => '%Perl%'}
2842
    ];    
2843
    
2844
    # Array reference 2 (String, hash reference)
2845
    where => [
2846
        'title like :title',
2847
        {title => '%Perl%'}
2848
    ]
2849
    
2850
    # String
2851
    where => 'title is null'
update pod
Yuki Kimoto authored on 2011-03-12
2852

            
updated document
Yuki Kimoto authored on 2011-06-09
2853
Where clause.
2854
    
improved pod
Yuki Kimoto authored on 2011-04-19
2855
=item C<wrap> EXPERIMENTAL
2856

            
2857
Wrap statement. This is array reference.
2858

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

            
2861
This option is for Oracle and SQL Server paging process.
2862

            
update pod
Yuki Kimoto authored on 2011-03-12
2863
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2864

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2869
Execute update statement. First argument is update data.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2870

            
updated document
Yuki Kimoto authored on 2011-06-09
2871
The following opitons are available.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2872

            
update pod
Yuki Kimoto authored on 2011-03-13
2873
=over 4
2874

            
updated document
Yuki Kimoto authored on 2011-06-09
2875
=item C<append>
update pod
Yuki Kimoto authored on 2011-03-13
2876

            
updated document
Yuki Kimoto authored on 2011-06-09
2877
Same as C<select> method's C<append> option.
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2878

            
updated document
Yuki Kimoto authored on 2011-06-09
2879
=item C<filter>
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2880

            
updated document
Yuki Kimoto authored on 2011-06-09
2881
Same as C<execute> method's C<filter> option.
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2882

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2885
    id => 4
2886
    id => [4, 5]
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
2887

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

            
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2891
    $dbi->update(
updated document
Yuki Kimoto authored on 2011-06-09
2892
        {title => 'Perl', author => 'Ken'}
2893
        parimary_key => ['id1', 'id2'],
2894
        id => [4, 5],
2895
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2896
    );
update pod
Yuki Kimoto authored on 2011-03-13
2897

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2900
    $dbi->update(
2901
        {title => 'Perl', author => 'Ken'}
2902
        where => {id1 => 4, id2 => 5},
2903
        table => 'book'
2904
    );
update pod
Yuki Kimoto authored on 2011-03-13
2905

            
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
2906
=item C<prefix> EXPERIMENTAL
2907

            
2908
    prefix => 'or replace'
2909

            
2910
prefix before table name section
2911

            
2912
    update or replace book
2913

            
updated document
Yuki Kimoto authored on 2011-06-09
2914
=item C<primary_key>
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
2915

            
updated document
Yuki Kimoto authored on 2011-06-09
2916
    primary_key => 'id'
2917
    primary_key => ['id1', 'id2']
update pod
Yuki Kimoto authored on 2011-03-13
2918

            
updated document
Yuki Kimoto authored on 2011-06-09
2919
Primary key. This is used by C<id> option.
update pod
Yuki Kimoto authored on 2011-03-13
2920

            
updated document
Yuki Kimoto authored on 2011-06-09
2921
=item C<query>
update pod
Yuki Kimoto authored on 2011-03-13
2922

            
updated document
Yuki Kimoto authored on 2011-06-09
2923
Same as C<execute> method's C<query> option.
update pod
Yuki Kimoto authored on 2011-03-13
2924

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

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
2931
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-13
2932

            
updated document
Yuki Kimoto authored on 2011-06-09
2933
Same as C<select> method's C<where> option.
update pod
Yuki Kimoto authored on 2011-03-13
2934

            
updated pod
Yuki Kimoto authored on 2011-06-21
2935
=item C<bind_type>
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2936

            
2937
Same as C<execute> method's C<type> option.
2938

            
2939
=item C<type_rule_off> EXPERIMENTAL
2940

            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
2941
Same as C<execute> method's C<type_rule_off> option.
2942

            
2943
=item C<type_rule1_off> EXPERIMENTAL
2944

            
2945
    type_rule1_off => 1
2946

            
2947
Same as C<execute> method's C<type_rule1_off> option.
2948

            
2949
=item C<type_rule2_off> EXPERIMENTAL
2950

            
2951
    type_rule2_off => 1
2952

            
2953
Same as C<execute> method's C<type_rule2_off> option.
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2954

            
updated pod
Yuki Kimoto authored on 2011-06-08
2955
=back
update pod
Yuki Kimoto authored on 2011-03-13
2956

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

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

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

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

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

            
2968
Create update parameter tag.
2969

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

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

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

            
2979
Create a new L<DBIx::Custom::Where> object.
2980

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

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

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

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

            
2990
=head2 C<DBIX_CUSTOM_DEBUG>
2991

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

            
2995
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2996

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

            
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
2999
=head1 DEPRECATED FUNCTIONALITIES
3000

            
3001
L<DBIx::Custom>
3002

            
3003
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3004
    data_source # will be removed at 2017/1/1
3005
    dbi_options # will be removed at 2017/1/1
3006
    filter_check # will be removed at 2017/1/1
3007
    reserved_word_quote # will be removed at 2017/1/1
3008
    cache_method # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3009
    
3010
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3011
    create_query # will be removed at 2017/1/1
3012
    apply_filter # will be removed at 2017/1/1
3013
    select_at # will be removed at 2017/1/1
3014
    delete_at # will be removed at 2017/1/1
3015
    update_at # will be removed at 2017/1/1
3016
    insert_at # will be removed at 2017/1/1
3017
    register_tag # will be removed at 2017/1/1
3018
    default_bind_filter # will be removed at 2017/1/1
3019
    default_fetch_filter # will be removed at 2017/1/1
3020
    insert_param_tag # will be removed at 2017/1/1
3021
    register_tag_processor # will be removed at 2017/1/1
3022
    update_param_tag # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3023
    
3024
    # Options
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3025
    select method relation option # will be removed at 2017/1/1
3026
    select method param option # will be removed at 2017/1/1
3027
    select method column option [COLUMN, as => ALIAS] format
3028
      # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3029
    
3030
    # Others
3031
    execute("select * from {= title}"); # execute tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3032
                                        # will be removed at 2017/1/1
3033
    Query caching # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3034

            
3035
L<DBIx::Custom::Model>
3036

            
3037
    # Attribute method
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3038
    filter # will be removed at 2017/1/1
3039
    name # will be removed at 2017/1/1
3040
    type # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3041

            
3042
L<DBIx::Custom::Query>
3043
    
3044
    # Attribute method
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3045
    default_filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3046

            
3047
L<DBIx::Custom::QueryBuilder>
3048
    
3049
    # Attribute method
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3050
    tags # will be removed at 2017/1/1
3051
    tag_processors # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3052
    
3053
    # Method
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3054
    register_tag # will be removed at 2017/1/1
3055
    register_tag_processor # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3056
    
3057
    # Others
3058
    build_query("select * from {= title}"); # tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3059
                                            # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3060

            
3061
L<DBIx::Custom::Result>
3062
    
3063
    # Attribute method
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3064
    filter_check # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3065
    
3066
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3067
    end_filter # will be removed at 2017/1/1
3068
    remove_end_filter # will be removed at 2017/1/1
3069
    remove_filter # will be removed at 2017/1/1
3070
    default_filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3071

            
3072
L<DBIx::Custom::Tag>
3073

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

            
3076
=head1 BACKWORD COMPATIBLE POLICY
3077

            
3078
If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3079
except for attribute method.
3080
You can check all DEPRECATED functionalities by document.
3081
DEPRECATED functionality is removed after five years,
3082
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
3083
I extend one year each time he tell me it.
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3084

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

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3087
This policy was changed at 2011/6/28
DBIx::Custom is now stable
yuki-kimoto authored on 2010-09-07
3088

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

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

            
3093
C<< <kimoto.yuki at gmail.com> >>
3094

            
3095
L<http://github.com/yuki-kimoto/DBIx-Custom>
3096

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
3097
=head1 AUTHOR
3098

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

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

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

            
3105
This program is free software; you can redistribute it and/or modify it
3106
under the same terms as Perl itself.
3107

            
3108
=cut