DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
3659 lines | 94.976kb
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 pass at...
Yuki Kimoto authored on 2011-09-02
4
our $VERSION = '0.1722';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
5
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
6

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

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
102
our $AUTOLOAD;
103
sub AUTOLOAD {
104
    my $self = shift;
105

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

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
123
sub assign_param {
updated pod
Yuki Kimoto authored on 2011-09-02
124
    my ($self, $param, $opts) = @_;
125
    
126
    my $wrap = $opts->{wrap} || {};
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
127
    
128
    # Create set tag
129
    my @params;
130
    my $safety = $self->safety_character;
insert and update method's p...
Yuki Kimoto authored on 2011-07-29
131
    foreach my $column (sort keys %$param) {
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
132
        croak qq{"$column" is not safety column name } . _subname
133
          unless $column =~ /^[$safety\.]+$/;
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
134
        my $column_quote = $self->_q($column);
135
        $column_quote =~ s/\./$self->_q(".")/e;
updated pod
Yuki Kimoto authored on 2011-09-02
136
        my $func = $wrap->{$column} || sub { $_[0] };
137
        push @params,
138
          ref $param->{$column} eq 'SCALAR' ? "$column_quote = " . ${$param->{$column}}
139
        : "$column_quote = " . $func->(":$column");
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
140
    }
141
    my $tag = join(', ', @params);
142
    
143
    return $tag;
144
}
145

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

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

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

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

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

            
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
236
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
237
    my $table = $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
238
    croak qq{"table" option must be specified. } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
239
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
240
    my $where            = delete $args{where} || {};
241
    my $append           = delete $args{append};
242
    my $allow_delete_all = delete $args{allow_delete_all};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
243
    my $where_param      = delete $args{where_param} || {};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
244
    my $id = delete $args{id};
245
    my $primary_key = delete $args{primary_key};
246
    croak "update method primary_key option " .
247
          "must be specified when id is specified " . _subname
248
      if defined $id && !defined $primary_key;
249
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
250
    my $prefix = delete $args{prefix};
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
251
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
252
    # Where
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
253
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
254
    my $where_clause = '';
updated pod
Yuki Kimoto authored on 2011-06-21
255
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
256
        $where_clause = "where " . $where->[0];
257
        $where_param = $where->[1];
258
    }
259
    elsif (ref $where) {
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
260
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
261
        $where_param = keys %$where_param
262
                     ? $self->merge_param($where_param, $where->param)
263
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
264
        
265
        # String where
266
        $where_clause = $where->to_string;
267
    }
268
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
269
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
270
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
271

            
cleanup
Yuki Kimoto authored on 2011-04-02
272
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
273
    my @sql;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
274
    push @sql, "delete";
275
    push @sql, $prefix if defined $prefix;
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
276
    push @sql, "from " . $self->_q($table) . " $where_clause";
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
277
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
278
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
279
    
280
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
281
    return $self->execute($sql, $where_param, table => $table, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
282
}
283

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

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

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
288
sub create_model {
289
    my $self = shift;
290
    
cleanup
Yuki Kimoto authored on 2011-04-02
291
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
292
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
293
    $args->{dbi} = $self;
294
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
295
    my $model_name  = delete $args->{name};
296
    my $model_table = delete $args->{table};
297
    $model_name ||= $model_table;
298
    
cleanup
Yuki Kimoto authored on 2011-04-02
299
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
300
    my $model = $model_class->new($args);
cleanup
Yuki Kimoto authored on 2011-08-13
301
    weaken $model->{dbi};
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
302
    $model->name($model_name) unless $model->name;
303
    $model->table($model_table) unless $model->table;
304
    
micro optimization
Yuki Kimoto authored on 2011-07-30
305
    # Apply filter(DEPRECATED logic)
306
    if ($model->{filter}) {
307
        my $filter = ref $model->filter eq 'HASH'
308
                   ? [%{$model->filter}]
309
                   : $model->filter;
310
        $filter ||= [];
311
        warn "DBIx::Custom::Model filter method is DEPRECATED!"
312
          if @$filter;
313
        $self->_apply_filter($model->table, @$filter);
314
    }
315
    
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
316
    # Set model
317
    $self->model($model->name, $model);
318
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
319
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
320
}
321

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

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
325
    my $user_column_info = $self->user_column_info;
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
326
    
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
327
    if ($user_column_info) {
328
        $self->$cb($_->{table}, $_->{column}, $_->{info}) for @$user_column_info;
329
    }
330
    else {
331
    
332
        my $re = $self->exclude_table || $options{exclude_table};
333
        # Tables
334
        my %tables;
335
        $self->each_table(sub { $tables{$_[1]}++ });
added SQL Server test
Yuki Kimoto authored on 2011-08-14
336

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
337
        # Iterate all tables
338
        my @tables = sort keys %tables;
339
        for (my $i = 0; $i < @tables; $i++) {
340
            my $table = $tables[$i];
341
            
342
            # Iterate all columns
343
            my $sth_columns;
344
            eval {$sth_columns = $self->dbh->column_info(undef, undef, $table, '%')};
345
            next if $@;
346
            while (my $column_info = $sth_columns->fetchrow_hashref) {
347
                my $column = $column_info->{COLUMN_NAME};
348
                $self->$cb($table, $column, $column_info);
349
            }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
350
        }
351
    }
352
}
353

            
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
354
sub each_table {
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
355
    my ($self, $cb, %option) = @_;
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
356
    
cleanup test
Yuki Kimoto authored on 2011-08-16
357
    my $user_table_infos = $self->user_table_info;
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
358
    
added test
Yuki Kimoto authored on 2011-08-16
359
    # Iterate tables
360
    if ($user_table_infos) {
361
        $self->$cb($_->{table}, $_->{info}) for @$user_table_infos;
362
    }
363
    else {
364
        my $re = $self->exclude_table || $option{exclude};
365
        my $sth_tables = $self->dbh->table_info;
366
        while (my $table_info = $sth_tables->fetchrow_hashref) {
367
            
368
            # Table
369
            my $table = $table_info->{TABLE_NAME};
370
            next if defined $re && $table =~ /$re/;
371
            $self->$cb($table, $table_info);
372
        }
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
373
    }
374
}
375

            
simplified arguments check
Yuki Kimoto authored on 2011-07-11
376
our %VALID_ARGS = map { $_ => 1 } qw/append allow_delete_all
377
  allow_update_all bind_type column filter id join param prefix primary_key
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
378
  query relation sqlfilter table table_alias timestamp type type_rule_off
379
  type_rule1_off type_rule2_off wrap/;
cleanup
Yuki Kimoto authored on 2011-04-02
380

            
381
sub execute {
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
382
    my $self = shift;
383
    my $query = shift;
384
    my $param;
385
    $param = shift if @_ % 2;
386
    my %args = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
387
    
cleanup
Yuki Kimoto authored on 2011-04-02
388
    # Arguments
execute method can second ar...
Yuki Kimoto authored on 2011-06-09
389
    my $p = delete $args{param} || {};
390
    $param ||= $p;
cleanup
Yuki Kimoto authored on 2011-04-02
391
    my $tables = delete $args{table} || [];
392
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
393
    my $filter = delete $args{filter};
cleanup
Yuki Kimoto authored on 2011-04-25
394
    $filter = _array_to_hash($filter);
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
395
    my $bind_type = delete $args{bind_type} || delete $args{type};
396
    $bind_type = _array_to_hash($bind_type);
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
397
    my $type_rule_off = delete $args{type_rule_off};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
398
    my $type_rule_off_parts = {
399
        1 => delete $args{type_rule1_off},
400
        2 => delete $args{type_rule2_off}
401
    };
cleanup
Yuki Kimoto authored on 2011-06-09
402
    my $query_return = delete $args{query};
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
403
    my $table_alias = delete $args{table_alias} || {};
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
404
    my $sqlfilter = $args{sqlfilter};
- removed placeholder count ...
Yuki Kimoto authored on 2011-08-22
405
    my $id = delete $args{id};
406
    my $primary_key = delete $args{primary_key};
407
    croak "insert method primary_key option " .
408
          "must be specified when id is specified " . _subname
409
      if defined $id && !defined $primary_key;
410
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
411

            
412
    if (defined $id) {
413
        my $id_param = $self->_create_param_from_id($id, $primary_key);
414
        $param = $self->merge_param($id_param, $param);
415
    }
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
416
    
cleanup
Yuki Kimoto authored on 2011-03-09
417
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
418
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
419
        croak qq{"$name" is wrong option } . _subname
simplified arguments check
Yuki Kimoto authored on 2011-07-11
420
          unless $VALID_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
421
    }
422
    
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
423
    $query = $self->_create_query($query, $sqlfilter) unless ref $query;
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
424
    
425
    # Save query
426
    $self->last_sql($query->sql);
427

            
cleanup
Yuki Kimoto authored on 2011-06-09
428
    return $query if $query_return;
micro optimization
Yuki Kimoto authored on 2011-07-30
429
    
430
    # DEPRECATED! Merge query filter
DBIx::Custom::Query filter m...
Yuki Kimoto authored on 2011-07-30
431
    $filter ||= $query->{filter} || {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
432
    
cleanup
Yuki Kimoto authored on 2011-04-02
433
    # Tables
DBIx::Custom::Query tables a...
Yuki Kimoto authored on 2011-07-30
434
    unshift @$tables, @{$query->{tables} || []};
micro optimization
Yuki Kimoto authored on 2011-07-30
435
    my $main_table = @{$tables}[-1];
micro optimization
Yuki Kimoto authored on 2011-07-30
436
    
micro optimization
Yuki Kimoto authored on 2011-07-30
437
    # DEPRECATED! Cleanup tables
micro optimization
Yuki Kimoto authored on 2011-07-30
438
    $tables = $self->_remove_duplicate_table($tables, $main_table)
439
      if @$tables > 1;
cleanup
Yuki Kimoto authored on 2011-04-02
440
    
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
441
    # Type rule
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
442
    my $type_filters = {};
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
443
    unless ($type_rule_off) {
micro optimization
Yuki Kimoto authored on 2011-07-30
444
        foreach my $i (1, 2) {
445
            unless ($type_rule_off_parts->{$i}) {
446
                $type_filters->{$i} = {};
447
                foreach my $alias (keys %$table_alias) {
448
                    my $table = $table_alias->{$alias};
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-06-27
449
                    
micro optimization
Yuki Kimoto authored on 2011-07-30
450
                    foreach my $column (keys %{$self->{"_into$i"}{key}{$table} || {}}) {
451
                        $type_filters->{$i}->{"$alias.$column"} = $self->{"_into$i"}{key}{$table}{$column};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
452
                    }
453
                }
micro optimization
Yuki Kimoto authored on 2011-07-30
454
                $type_filters->{$i} = {%{$type_filters->{$i}}, %{$self->{"_into$i"}{key}{$main_table} || {}}}
455
                  if $main_table;
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
456
            }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
457
        }
458
    }
cleanup
Yuki Kimoto authored on 2011-04-02
459
    
micro optimization
Yuki Kimoto authored on 2011-07-30
460
    # DEPRECATED! Applied filter
micro optimization
Yuki Kimoto authored on 2011-07-30
461
    if ($self->{filter}{on}) {
462
        my $applied_filter = {};
463
        foreach my $table (@$tables) {
464
            $applied_filter = {
465
                %$applied_filter,
466
                %{$self->{filter}{out}->{$table} || {}}
467
            }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
468
        }
micro optimization
Yuki Kimoto authored on 2011-07-30
469
        $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
470
    }
471
    
cleanup
Yuki Kimoto authored on 2011-04-02
472
    # Replace filter name to code
473
    foreach my $column (keys %$filter) {
474
        my $name = $filter->{$column};
475
        if (!defined $name) {
476
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
477
        }
cleanup
Yuki Kimoto authored on 2011-04-02
478
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
479
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
480
            unless exists $self->filters->{$name};
481
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
482
        }
483
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
484
    
cleanup
Yuki Kimoto authored on 2011-04-02
485
    # Create bind values
486
    my $bind = $self->_create_bind_values(
487
        $param,
488
        $query->columns,
489
        $filter,
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
490
        $type_filters,
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
491
        $bind_type
cleanup
Yuki Kimoto authored on 2011-04-02
492
    );
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
493

            
cleanup
yuki-kimoto authored on 2010-10-17
494
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
495
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
496
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
497
    eval {
498
        for (my $i = 0; $i < @$bind; $i++) {
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
499
            my $bind_type = $bind->[$i]->{bind_type};
500
            $sth->bind_param(
501
                $i + 1,
502
                $bind->[$i]->{value},
503
                $bind_type ? $bind_type : ()
504
            );
cleanup
Yuki Kimoto authored on 2011-03-21
505
        }
506
        $affected = $sth->execute;
507
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
508
    
micro optimization
Yuki Kimoto authored on 2011-07-30
509
    $self->_croak($@, qq{. Following SQL is executed.\n}
510
      . qq{$query->{sql}\n} . _subname) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
511
    
improved debug message
Yuki Kimoto authored on 2011-05-23
512
    # DEBUG message
513
    if (DEBUG) {
514
        print STDERR "SQL:\n" . $query->sql . "\n";
515
        my @output;
516
        foreach my $b (@$bind) {
517
            my $value = $b->{value};
518
            $value = 'undef' unless defined $value;
519
            $value = encode(DEBUG_ENCODING(), $value)
520
              if utf8::is_utf8($value);
521
            push @output, $value;
522
        }
523
        print STDERR "Bind values: " . join(', ', @output) . "\n\n";
524
    }
added environment variable D...
Yuki Kimoto authored on 2011-04-02
525
    
cleanup
Yuki Kimoto authored on 2011-04-02
526
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
527
    if ($sth->{NUM_OF_FIELDS}) {
528
        
micro optimization
Yuki Kimoto authored on 2011-07-30
529
        # DEPRECATED! Filter
cleanup
Yuki Kimoto authored on 2011-04-02
530
        my $filter = {};
micro optimization
Yuki Kimoto authored on 2011-07-30
531
        if ($self->{filter}{on}) {
532
            $filter->{in}  = {};
533
            $filter->{end} = {};
534
            push @$tables, $main_table if $main_table;
535
            foreach my $table (@$tables) {
536
                foreach my $way (qw/in end/) {
537
                    $filter->{$way} = {
538
                        %{$filter->{$way}},
539
                        %{$self->{filter}{$way}{$table} || {}}
540
                    };
541
                }
cleanup
Yuki Kimoto authored on 2011-04-02
542
            }
cleanup
Yuki Kimoto authored on 2011-01-12
543
        }
544
        
545
        # Result
546
        my $result = $self->result_class->new(
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
547
            sth => $sth,
sub module use DBIx::Custom ...
Yuki Kimoto authored on 2011-08-02
548
            dbi => $self,
cleanup
Yuki Kimoto authored on 2011-01-12
549
            default_filter => $self->{default_in_filter},
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
550
            filter => $filter->{in} || {},
551
            end_filter => $filter->{end} || {},
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
552
            type_rule => {
553
                from1 => $self->type_rule->{from1},
554
                from2 => $self->type_rule->{from2}
555
            },
cleanup
yuki-kimoto authored on 2010-10-17
556
        );
557

            
558
        return $result;
559
    }
cleanup
Yuki Kimoto authored on 2011-04-02
560
    
561
    # Not select statement
562
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
563
}
564

            
added test
Yuki Kimoto authored on 2011-08-16
565
sub get_table_info {
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
566
    my ($self, %args) = @_;
567
    
568
    my $exclude = delete $args{exclude};
569
    croak qq/"$_" is wrong option/ for keys %args;
570
    
added test
Yuki Kimoto authored on 2011-08-16
571
    my $table_info = [];
572
    $self->each_table(
573
        sub { push @$table_info, {table => $_[1], info => $_[2] } },
574
        exclude => $exclude
575
    );
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
576
    
cleanup test
Yuki Kimoto authored on 2011-08-16
577
    return [sort {$a->{table} cmp $b->{table} } @$table_info];
added EXPERIMENTAL find_tabl...
Yuki Kimoto authored on 2011-08-16
578
}
579

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
580
sub get_column_info {
581
    my ($self, %args) = @_;
582
    
583
    my $exclude_table = delete $args{exclude_table};
584
    croak qq/"$_" is wrong option/ for keys %args;
585
    
586
    my $column_info = [];
587
    $self->each_column(
588
        sub { push @$column_info, {table => $_[1], column => $_[2], info => $_[3] } },
589
        exclude_table => $exclude_table
590
    );
591
    
592
    return [
593
      sort {$a->{table} cmp $b->{table} || $a->{column} cmp $b->{column} }
cleanup
Yuki Kimoto authored on 2011-08-16
594
        @$column_info];
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
595
}
596

            
cleanup
yuki-kimoto authored on 2010-10-17
597
sub insert {
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
598
    my $self = shift;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
599
    
cleanup
yuki-kimoto authored on 2010-10-17
600
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
601
    my $param;
602
    $param = shift if @_ % 2;
603
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
604
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
605
    croak qq{"table" option must be specified } . _subname
simplified arguments check
Yuki Kimoto authored on 2011-07-11
606
      unless defined $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
607
    my $p = delete $args{param} || {};
608
    $param  ||= $p;
cleanup
Yuki Kimoto authored on 2011-03-21
609
    my $append = delete $args{append} || '';
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
610
    my $id = delete $args{id};
611
    my $primary_key = delete $args{primary_key};
cleanup
Yuki Kimoto authored on 2011-06-08
612
    croak "insert method primary_key option " .
added tests
Yuki Kimoto authored on 2011-06-08
613
          "must be specified when id is specified " . _subname
614
      if defined $id && !defined $primary_key;
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
615
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
616
    my $prefix = delete $args{prefix};
updated pod
Yuki Kimoto authored on 2011-09-02
617
    my $wrap = delete $args{wrap};
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
618
    my $timestamp = $args{timestamp};
619
    
620
    # Timestamp
621
    if ($timestamp) {
622
        my $column = $self->timestamp->{insert}[0];
623
        my $v   = $self->timestamp->{insert}[1];
624
        my $value;
625
        
626
        if (defined $column && defined $v) {
627
            $value = ref $v eq 'SCALAR' ? $v : \$v;
628
            $param->{$column} = $value;
629
        }
630
    }
cleanup
Yuki Kimoto authored on 2011-04-02
631

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
638
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
639
    my @sql;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
640
    push @sql, "insert";
641
    push @sql, $prefix if defined $prefix;
updated pod
Yuki Kimoto authored on 2011-09-02
642
    push @sql, "into " . $self->_q($table) . " "
643
      . $self->insert_param($param, {wrap => $wrap});
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
644
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
645
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
646
    
647
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
648
    return $self->execute($sql, $param, table => $table, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
649
}
650

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
651
sub insert_param {
updated pod
Yuki Kimoto authored on 2011-09-02
652
    my ($self, $param, $opts) = @_;
653
    
654
    my $wrap = $opts->{wrap} || {};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
655
    
cleanup
Yuki Kimoto authored on 2011-04-02
656
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
657
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
658
    my @columns;
659
    my @placeholders;
insert and update method's p...
Yuki Kimoto authored on 2011-07-29
660
    foreach my $column (sort keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
661
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
662
          unless $column =~ /^[$safety\.]+$/;
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
663
        my $column_quote = $self->_q($column);
664
        $column_quote =~ s/\./$self->_q(".")/e;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
665
        push @columns, $column_quote;
updated pod
Yuki Kimoto authored on 2011-09-02
666
        
667
        my $func = $wrap->{$column} || sub { $_[0] };
668
        push @placeholders,
669
          ref $param->{$column} eq 'SCALAR' ? ${$param->{$column}}
670
        : $func->(":$column");
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
671
    }
672
    
cleanup
Yuki Kimoto authored on 2011-04-02
673
    return '(' . join(', ', @columns) . ') ' . 'values ' .
674
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
675
}
676

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

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

            
added DBIx::Custom::Mapper
Yuki Kimoto authored on 2011-08-26
742
sub mapper {
743
    my $self = shift;
744
    return DBIx::Custom::Mapper->new(@_);
745
}
746

            
added EXPERIMENTAL map_param...
Yuki Kimoto authored on 2011-06-24
747
sub map_param {
748
    my $self = shift;
749
    my $param = shift;
750
    my %map = @_;
751
    
752
    # Mapping
753
    my $map_param = {};
754
    foreach my $key (keys %map) {
755
        my $value_cb;
756
        my $condition;
757
        my $map_key;
758
        
759
        # Get mapping information
760
        if (ref $map{$key} eq 'ARRAY') {
761
            foreach my $some (@{$map{$key}}) {
762
                $map_key = $some unless ref $some;
763
                $condition = $some->{if} if ref $some eq 'HASH';
764
                $value_cb = $some if ref $some eq 'CODE';
765
            }
766
        }
767
        else {
768
            $map_key = $map{$key};
769
        }
770
        $value_cb ||= sub { $_[0] };
771
        $condition ||= sub { defined $_[0] && length $_[0] };
772

            
773
        # Map parameter
774
        my $value;
775
        if (ref $condition eq 'CODE') {
776
            $map_param->{$map_key} = $value_cb->($param->{$key})
777
              if $condition->($param->{$key});
778
        }
779
        elsif ($condition eq 'exists') {
780
            $map_param->{$map_key} = $value_cb->($param->{$key})
781
              if exists $param->{$key};
782
        }
783
        else { croak qq/Condition must be code reference or "exists" / . _subname }
784
    }
785
    
786
    return $map_param;
787
}
788

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
789
sub merge_param {
790
    my ($self, @params) = @_;
791
    
cleanup
Yuki Kimoto authored on 2011-04-02
792
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
793
    my $merge = {};
794
    foreach my $param (@params) {
795
        foreach my $column (keys %$param) {
796
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
797
            
798
            if (exists $merge->{$column}) {
799
                $merge->{$column} = [$merge->{$column}]
800
                  unless ref $merge->{$column} eq 'ARRAY';
801
                push @{$merge->{$column}},
802
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
803
            }
804
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
805
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
806
            }
807
        }
808
    }
809
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
810
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
811
}
812

            
cleanup
Yuki Kimoto authored on 2011-03-21
813
sub method {
814
    my $self = shift;
815
    
cleanup
Yuki Kimoto authored on 2011-04-02
816
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
817
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
818
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
819
    
820
    return $self;
821
}
822

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
823
sub model {
824
    my ($self, $name, $model) = @_;
825
    
cleanup
Yuki Kimoto authored on 2011-04-02
826
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
827
    if ($model) {
828
        $self->models->{$name} = $model;
829
        return $self;
830
    }
831
    
832
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
833
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
834
      unless $self->models->{$name};
835
    
cleanup
Yuki Kimoto authored on 2011-04-02
836
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
837
    return $self->models->{$name};
838
}
839

            
cleanup
Yuki Kimoto authored on 2011-03-21
840
sub mycolumn {
841
    my ($self, $table, $columns) = @_;
842
    
cleanup
Yuki Kimoto authored on 2011-04-02
843
    # Create column clause
844
    my @column;
cleanup
Yuki Kimoto authored on 2011-03-21
845
    $columns ||= [];
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
846
    push @column, $self->_q($table) . "." . $self->_q($_) .
847
      " as " . $self->_q($_)
848
      for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
849
    
850
    return join (', ', @column);
851
}
852

            
added dbi_options attribute
kimoto authored on 2010-12-20
853
sub new {
854
    my $self = shift->SUPER::new(@_);
855
    
cleanup
Yuki Kimoto authored on 2011-04-02
856
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
857
    my @attrs = keys %$self;
858
    foreach my $attr (@attrs) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
859
        croak qq{Invalid attribute: "$attr" } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
860
          unless $self->can($attr);
861
    }
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
862

            
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
863
    # DEPRECATED
cleanup
Yuki Kimoto authored on 2011-08-13
864
    $self->{_tags} = {
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
865
        '?'     => \&DBIx::Custom::Tag::placeholder,
866
        '='     => \&DBIx::Custom::Tag::equal,
867
        '<>'    => \&DBIx::Custom::Tag::not_equal,
868
        '>'     => \&DBIx::Custom::Tag::greater_than,
869
        '<'     => \&DBIx::Custom::Tag::lower_than,
870
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
871
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
872
        'like'  => \&DBIx::Custom::Tag::like,
873
        'in'    => \&DBIx::Custom::Tag::in,
874
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
875
        'update_param' => \&DBIx::Custom::Tag::update_param
cleanup
Yuki Kimoto authored on 2011-08-13
876
    };
877
    
878
    return $self;
879
}
880

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

            
883
sub order {
884
    my $self = shift;
885
    return DBIx::Custom::Order->new(dbi => $self, @_);
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
886
}
887

            
cleanup
yuki-kimoto authored on 2010-10-17
888
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
889
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
890
    
891
    # Register filter
892
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
893
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
894
    
cleanup
Yuki Kimoto authored on 2011-04-02
895
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
896
}
packaging one directory
yuki-kimoto authored on 2009-11-16
897

            
898
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
899
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
900

            
refactoring select
yuki-kimoto authored on 2010-04-28
901
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
902
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
903
    my $tables = ref $table eq 'ARRAY' ? $table
904
               : defined $table ? [$table]
905
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
906
    my $columns   = delete $args{column};
907
    my $where     = delete $args{where} || {};
908
    my $append    = delete $args{append};
909
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
910
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
911
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
912
    my $relation = delete $args{relation};
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
913
    warn "select() relation option is DEPRECATED!"
added warnings
Yuki Kimoto authored on 2011-06-07
914
      if $relation;
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
915
    my $param = delete $args{param} || {}; # DEPRECATED!
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
916
    warn "select() param option is DEPRECATED!"
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
917
      if keys %$param;
918
    my $where_param = delete $args{where_param} || $param || {};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
919
    my $id = delete $args{id};
920
    my $primary_key = delete $args{primary_key};
921
    croak "update method primary_key option " .
922
          "must be specified when id is specified " . _subname
923
      if defined $id && !defined $primary_key;
924
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
925
    my $prefix = delete $args{prefix};
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
926
    
cleanup
Yuki Kimoto authored on 2011-03-09
927
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
928
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
929
    
cleanup
Yuki Kimoto authored on 2011-04-02
930
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
931
    my @sql;
932
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
933
    
added EXPERIMENTAL select pr...
Yuki Kimoto authored on 2011-06-13
934
    # Prefix
935
    push @sql, $prefix if defined $prefix;
936
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
937
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
938
    if ($columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-07
939
        $columns = [$columns] unless ref $columns eq 'ARRAY';
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
940
        foreach my $column (@$columns) {
- select() column option can...
Yuki Kimoto authored on 2011-06-08
941
            if (ref $column eq 'HASH') {
EXPERIMTANL column method th...
Yuki Kimoto authored on 2011-06-13
942
                $column = $self->column(%$column) if ref $column eq 'HASH';
- select() column option can...
Yuki Kimoto authored on 2011-06-08
943
            }
944
            elsif (ref $column eq 'ARRAY') {
- select method column optio...
Yuki Kimoto authored on 2011-07-11
945
                if (@$column == 3 && $column->[1] eq 'as') {
946
                    warn "[COLUMN, as => ALIAS] is DEPRECATED! use [COLUMN => ALIAS]";
947
                    splice @$column, 1, 1;
948
                }
949
                
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
950
                $column = join(' ', $column->[0], 'as', $self->_q($column->[1]));
- select() column option can...
Yuki Kimoto authored on 2011-06-08
951
            }
cleanup
Yuki Kimoto authored on 2011-04-02
952
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
953
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
954
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
955
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
956
    }
957
    else { push @sql, '*' }
958
    
959
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
960
    push @sql, 'from';
961
    if ($relation) {
962
        my $found = {};
963
        foreach my $table (@$tables) {
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
964
            push @sql, ($self->_q($table), ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
965
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
966
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
967
    }
cleanup
Yuki Kimoto authored on 2011-03-30
968
    else {
969
        my $main_table = $tables->[-1] || '';
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
970
        push @sql, $self->_q($main_table);
cleanup
Yuki Kimoto authored on 2011-03-30
971
    }
972
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
973
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
974
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
975

            
cleanup
Yuki Kimoto authored on 2011-04-02
976
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
977
    unshift @$tables,
978
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
979
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
980
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
981
    my $where_clause = '';
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
982
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
updated pod
Yuki Kimoto authored on 2011-06-21
983
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
984
        $where_clause = "where " . $where->[0];
985
        $where_param = $where->[1];
986
    }
987
    elsif (ref $where) {
cleanup
Yuki Kimoto authored on 2011-04-25
988
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
989
        $where_param = keys %$where_param
990
                     ? $self->merge_param($where_param, $where->param)
991
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
992
        
993
        # String where
994
        $where_clause = $where->to_string;
995
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
996
    elsif ($where) { $where_clause = "where $where" }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
997
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
998
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
999
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1000
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1001
    # Push join
1002
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1003
    
cleanup
Yuki Kimoto authored on 2011-03-09
1004
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
1005
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1006
    
cleanup
Yuki Kimoto authored on 2011-03-08
1007
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
1008
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
1009
    
cleanup
Yuki Kimoto authored on 2011-04-02
1010
    # Append
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1011
    push @sql, $append if defined $append;
cleanup
Yuki Kimoto authored on 2011-01-27
1012
    
1013
    # SQL
1014
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
1015
    
1016
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
1017
    my $result = $self->execute($sql, $where_param, table => $tables, %args);
packaging one directory
yuki-kimoto authored on 2009-11-16
1018
    
1019
    return $result;
1020
}
1021

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1022
sub setup_model {
1023
    my $self = shift;
1024
    
cleanup
Yuki Kimoto authored on 2011-04-02
1025
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1026
    $self->each_column(
1027
        sub {
1028
            my ($self, $table, $column, $column_info) = @_;
1029
            if (my $model = $self->models->{$table}) {
1030
                push @{$model->columns}, $column;
1031
            }
1032
        }
1033
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1034
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1035
}
1036

            
update pod
Yuki Kimoto authored on 2011-08-10
1037
sub show_datatype {
1038
    my ($self, $table) = @_;
1039
    croak "Table name must be specified" unless defined $table;
1040
    print "$table\n";
1041
    
1042
    my $result = $self->select(table => $table, where => "'0' <> '0'");
1043
    my $sth = $result->sth;
1044

            
1045
    my $columns = $sth->{NAME};
1046
    my $data_types = $sth->{TYPE};
1047
    
1048
    for (my $i = 0; $i < @$columns; $i++) {
1049
        my $column = $columns->[$i];
1050
        my $data_type = $data_types->[$i];
1051
        print "$column: $data_type\n";
1052
    }
1053
}
1054

            
1055
sub show_typename {
1056
    my ($self, $t) = @_;
1057
    croak "Table name must be specified" unless defined $t;
1058
    print "$t\n";
1059
    
1060
    $self->each_column(sub {
1061
        my ($self, $table, $column, $infos) = @_;
1062
        return unless $table eq $t;
1063
        my $typename = $infos->{TYPE_NAME};
1064
        print "$column: $typename\n";
1065
    });
1066
    
1067
    return $self;
1068
}
1069

            
test cleanup
Yuki Kimoto authored on 2011-08-15
1070
sub show_tables {
1071
    my $self = shift;
1072
    
1073
    my %tables;
1074
    $self->each_table(sub { $tables{$_[1]}++ });
1075
    print join("\n", sort keys %tables) . "\n";
1076
    return $self;
1077
}
1078

            
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1079
sub type_rule {
1080
    my $self = shift;
1081
    
1082
    if (@_) {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
1083
        my $type_rule = ref $_[0] eq 'HASH' ? $_[0] : {@_};
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1084
        
1085
        # Into
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1086
        foreach my $i (1 .. 2) {
1087
            my $into = "into$i";
cleanup
Yuki Kimoto authored on 2011-08-16
1088
            my $exists_into = exists $type_rule->{$into};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1089
            $type_rule->{$into} = _array_to_hash($type_rule->{$into});
1090
            $self->{type_rule} = $type_rule;
1091
            $self->{"_$into"} = {};
1092
            foreach my $type_name (keys %{$type_rule->{$into} || {}}) {
1093
                croak qq{type name of $into section must be lower case}
1094
                  if $type_name =~ /[A-Z]/;
1095
            }
cleanup
Yuki Kimoto authored on 2011-08-16
1096
            
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1097
            $self->each_column(sub {
1098
                my ($dbi, $table, $column, $column_info) = @_;
1099
                
1100
                my $type_name = lc $column_info->{TYPE_NAME};
1101
                if ($type_rule->{$into} &&
1102
                    (my $filter = $type_rule->{$into}->{$type_name}))
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1103
                {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1104
                    return unless exists $type_rule->{$into}->{$type_name};
1105
                    if  (defined $filter && ref $filter ne 'CODE') 
1106
                    {
1107
                        my $fname = $filter;
1108
                        croak qq{Filter "$fname" is not registered" } . _subname
1109
                          unless exists $self->filters->{$fname};
1110
                        
1111
                        $filter = $self->filters->{$fname};
1112
                    }
1113

            
micro optimization
Yuki Kimoto authored on 2011-07-30
1114
                    $self->{"_$into"}{key}{$table}{$column} = $filter;
1115
                    $self->{"_$into"}{dot}{"$table.$column"} = $filter;
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1116
                }
1117
            });
1118
        }
1119

            
1120
        # From
1121
        foreach my $i (1 .. 2) {
1122
            $type_rule->{"from$i"} = _array_to_hash($type_rule->{"from$i"});
1123
            foreach my $data_type (keys %{$type_rule->{"from$i"} || {}}) {
1124
                croak qq{data type of from$i section must be lower case or number}
1125
                  if $data_type =~ /[A-Z]/;
1126
                my $fname = $type_rule->{"from$i"}{$data_type};
1127
                if (defined $fname && ref $fname ne 'CODE') {
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1128
                    croak qq{Filter "$fname" is not registered" } . _subname
1129
                      unless exists $self->filters->{$fname};
1130
                    
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1131
                    $type_rule->{"from$i"}{$data_type} = $self->filters->{$fname};
type_rule can receive filter...
Yuki Kimoto authored on 2011-06-12
1132
                }
fixed bug that type_rule fro...
Yuki Kimoto authored on 2011-06-13
1133
            }
1134
        }
1135
        
added type_rule method and f...
Yuki Kimoto authored on 2011-06-09
1136
        return $self;
1137
    }
1138
    
1139
    return $self->{type_rule} || {};
1140
}
1141

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1145
    # Arguments
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1146
    my $param;
1147
    $param = shift if @_ % 2;
1148
    my %args = @_;
cleanup
Yuki Kimoto authored on 2011-03-21
1149
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
1150
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
1151
      unless $table;
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
1152
    my $p = delete $args{param} || {};
1153
    $param  ||= $p;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1154
    my $where = delete $args{where} || {};
1155
    my $where_param = delete $args{where_param} || {};
1156
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-03-21
1157
    my $allow_update_all = delete $args{allow_update_all};
cleanup
Yuki Kimoto authored on 2011-06-08
1158
    my $id = delete $args{id};
1159
    my $primary_key = delete $args{primary_key};
1160
    croak "update method primary_key option " .
1161
          "must be specified when id is specified " . _subname
1162
      if defined $id && !defined $primary_key;
1163
    $primary_key = [$primary_key] unless ref $primary_key eq 'ARRAY';
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1164
    my $prefix = delete $args{prefix};
updated pod
Yuki Kimoto authored on 2011-09-02
1165
    my $wrap = delete $args{wrap};
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
1166
    my $timestamp = $args{timestamp};
1167
    
1168
    # Timestamp
1169
    if ($timestamp) {
1170
        my $column = $self->timestamp->{update}[0];
1171
        my $v   = $self->timestamp->{update}[1];
1172
        my $value;
1173
        
1174
        if (defined $column && defined $v) {
1175
            $value = ref $v eq 'SCALAR' ? $v : \$v;
1176
            $param->{$column} = $value;
1177
        }
1178
    }
1179

            
update_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1180

            
cleanup
yuki-kimoto authored on 2010-10-17
1181
    # Update clause
updated pod
Yuki Kimoto authored on 2011-09-02
1182
    my $update_clause = $self->update_param($param, {wrap => $wrap});
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1183

            
1184
    # Where
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
1185
    $where = $self->_create_param_from_id($id, $primary_key) if defined $id;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1186
    my $where_clause = '';
updated pod
Yuki Kimoto authored on 2011-06-21
1187
    if (ref $where eq 'ARRAY' && !ref $where->[0]) {
1188
        $where_clause = "where " . $where->[0];
1189
        $where_param = $where->[1];
1190
    }
1191
    elsif (ref $where) {
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1192
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1193
        $where_param = keys %$where_param
1194
                     ? $self->merge_param($where_param, $where->param)
1195
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1196
        
1197
        # String where
1198
        $where_clause = $where->to_string;
1199
    }
1200
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1201
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1202
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1203
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1204
    # Merge param
1205
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1206
    
cleanup
Yuki Kimoto authored on 2011-04-02
1207
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1208
    my @sql;
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1209
    push @sql, "update";
1210
    push @sql, $prefix if defined $prefix;
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1211
    push @sql, $self->_q($table) . " $update_clause $where_clause";
added EXPERIMENTAL insert, u...
Yuki Kimoto authored on 2011-06-21
1212
    push @sql, $append if defined $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1213
    
cleanup
Yuki Kimoto authored on 2011-01-27
1214
    # SQL
1215
    my $sql = join(' ', @sql);
1216
    
cleanup
yuki-kimoto authored on 2010-10-17
1217
    # Execute query
updated pod
Yuki Kimoto authored on 2011-06-21
1218
    return $self->execute($sql, $param, table => $table, %args);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1219
}
1220

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

            
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1223
sub update_param {
updated pod
Yuki Kimoto authored on 2011-09-02
1224
    my ($self, $param, $opts) = @_;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1225
    
cleanup
Yuki Kimoto authored on 2011-04-02
1226
    # Create update parameter tag
updated pod
Yuki Kimoto authored on 2011-09-02
1227
    my $tag = $self->assign_param($param, $opts);
1228
    $tag = "set $tag" unless $opts->{no_set};
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1229

            
cleanup
Yuki Kimoto authored on 2011-04-02
1230
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1231
}
1232

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
1235
sub _create_query {
cleanup
Yuki Kimoto authored on 2011-06-13
1236
    
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
1237
    my ($self, $source, $sqlfilter) = @_;
cleanup
Yuki Kimoto authored on 2011-06-13
1238
    
updated pod
Yuki Kimoto authored on 2011-06-21
1239
    # Cache
1240
    my $cache = $self->cache;
1241
    
1242
    # Query
1243
    my $query;
1244
    
1245
    # Get cached query
1246
    if ($cache) {
cleanup
Yuki Kimoto authored on 2011-06-13
1247
        
updated pod
Yuki Kimoto authored on 2011-06-21
1248
        # Get query
1249
        my $q = $self->cache_method->($self, $source);
cleanup
Yuki Kimoto authored on 2011-06-13
1250
        
updated pod
Yuki Kimoto authored on 2011-06-21
1251
        # Create query
1252
        if ($q) {
1253
            $query = DBIx::Custom::Query->new($q);
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
1254
            $query->{filters} = $self->filters;
cleanup
Yuki Kimoto authored on 2011-06-13
1255
        }
updated pod
Yuki Kimoto authored on 2011-06-21
1256
    }
1257
    
1258
    # Create query
1259
    unless ($query) {
1260

            
1261
        # Create query
1262
        my $builder = $self->query_builder;
1263
        $query = $builder->build_query($source);
1264

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

            
1271
        # Save query to cache
1272
        $self->cache_method->(
1273
            $self, $source,
1274
            {
1275
                sql     => $query->sql, 
1276
                columns => $query->columns,
DBIx::Custom::Query tables a...
Yuki Kimoto authored on 2011-07-30
1277
                tables  => $query->{tables} || []
updated pod
Yuki Kimoto authored on 2011-06-21
1278
            }
1279
        ) if $cache;
cleanup
Yuki Kimoto authored on 2011-06-13
1280
    }
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
1281

            
1282
    # Filter SQL
1283
    if ($sqlfilter) {
1284
        my $sql = $query->sql;
1285
        $sql = $sqlfilter->($sql);
1286
        $query->sql($sql);
1287
    }
1288
        
added EXPERIMENTAL last_sql ...
Yuki Kimoto authored on 2011-07-11
1289
    # Save sql
1290
    $self->last_sql($query->sql);
1291
    
updated pod
Yuki Kimoto authored on 2011-06-21
1292
    # Prepare statement handle
1293
    my $sth;
1294
    eval { $sth = $self->dbh->prepare($query->{sql})};
1295
    
1296
    if ($@) {
1297
        $self->_croak($@, qq{. Following SQL is executed.\n}
1298
                        . qq{$query->{sql}\n} . _subname);
1299
    }
1300
    
1301
    # Set statement handle
1302
    $query->sth($sth);
1303
    
1304
    # Set filters
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
1305
    $query->{filters} = $self->filters;
updated pod
Yuki Kimoto authored on 2011-06-21
1306
    
1307
    return $query;
cleanup
Yuki Kimoto authored on 2011-06-13
1308
}
1309

            
cleanup
Yuki Kimoto authored on 2011-04-02
1310
sub _create_bind_values {
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1311
    my ($self, $params, $columns, $filter, $type_filters, $bind_type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1312
    
cleanup
Yuki Kimoto authored on 2011-04-02
1313
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1314
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1315
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1316
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1317
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1318
        
1319
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1320
        my $value;
1321
        if(ref $params->{$column} eq 'ARRAY') {
1322
            my $i = $count->{$column} || 0;
1323
            $i += $not_exists->{$column} || 0;
1324
            my $found;
1325
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1326
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1327
                    $not_exists->{$column}++;
1328
                }
1329
                else  {
1330
                    $value = $params->{$column}->[$k];
1331
                    $found = 1;
1332
                    last
1333
                }
1334
            }
1335
            next unless $found;
1336
        }
1337
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1338
        
cleanup
Yuki Kimoto authored on 2011-01-12
1339
        # Filter
1340
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
1341
        $value = $f->($value) if $f;
1342
        
1343
        # Type rule
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1344
        foreach my $i (1 .. 2) {
1345
            my $type_filter = $type_filters->{$i};
micro optimization
Yuki Kimoto authored on 2011-07-30
1346
            my $tf = $self->{"_into$i"}->{dot}->{$column} || $type_filter->{$column};
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
1347
            $value = $tf->($value) if $tf;
1348
        }
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1349
        
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
1350
        # Bind values
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
1351
        push @$bind, {value => $value, bind_type => $bind_type->{$column}};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1352
        
1353
        # Count up 
1354
        $count->{$column}++;
1355
    }
1356
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1357
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1358
}
1359

            
cleanup
Yuki Kimoto authored on 2011-06-08
1360
sub _create_param_from_id {
1361
    my ($self, $id, $primary_keys) = @_;
improved error messages
Yuki Kimoto authored on 2011-04-18
1362
    
cleanup
Yuki Kimoto authored on 2011-06-08
1363
    # Create parameter
1364
    my $param = {};
fixed small insert, update, ...
Yuki Kimoto authored on 2011-06-21
1365
    if (defined $id) {
cleanup
Yuki Kimoto authored on 2011-06-08
1366
        $id = [$id] unless ref $id;
1367
        croak qq{"id" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1368
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1369
          unless !ref $id || ref $id eq 'ARRAY';
1370
        croak qq{"id" must contain values same count as primary key}
improved error messages
Yuki Kimoto authored on 2011-04-18
1371
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-06-08
1372
          unless @$primary_keys eq @$id;
improved error messages
Yuki Kimoto authored on 2011-04-18
1373
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-06-08
1374
           $param->{$primary_keys->[$i]} = $id->[$i];
improved error messages
Yuki Kimoto authored on 2011-04-18
1375
        }
1376
    }
1377
    
cleanup
Yuki Kimoto authored on 2011-06-08
1378
    return $param;
improved error messages
Yuki Kimoto authored on 2011-04-18
1379
}
1380

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1381
sub _connect {
1382
    my $self = shift;
1383
    
1384
    # Attributes
added warnings
Yuki Kimoto authored on 2011-06-07
1385
    my $dsn = $self->data_source;
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1386
    warn "data_source is DEPRECATED!\n"
fixed bug that data_source D...
Yuki Kimoto authored on 2011-06-13
1387
      if $dsn;
added warnings
Yuki Kimoto authored on 2011-06-07
1388
    $dsn ||= $self->dsn;
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1389
    croak qq{"dsn" must be specified } . _subname
1390
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1391
    my $user        = $self->user;
1392
    my $password    = $self->password;
1393
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added warnings
Yuki Kimoto authored on 2011-06-07
1394
    warn "dbi_options is DEPRECATED! use dbi_option instead\n"
1395
      if keys %{$self->dbi_options};
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1396
    
cleanup
Yuki Kimoto authored on 2011-08-16
1397
    $dbi_option = {%{$self->default_dbi_option}, %$dbi_option};
1398
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1399
    # Connect
cleanup
Yuki Kimoto authored on 2011-08-16
1400
    my $dbh;
1401
    eval {
1402
        $dbh = DBI->connect(
1403
            $dsn,
1404
            $user,
1405
            $password,
1406
            $dbi_option
1407
        );
1408
    };
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1409
    
1410
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1411
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1412
    
1413
    return $dbh;
1414
}
1415

            
cleanup
yuki-kimoto authored on 2010-10-17
1416
sub _croak {
1417
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1418
    
1419
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1420
    $append ||= "";
1421
    
1422
    # Verbose
1423
    if ($Carp::Verbose) { croak $error }
1424
    
1425
    # Not verbose
1426
    else {
1427
        
1428
        # Remove line and module infromation
1429
        my $at_pos = rindex($error, ' at ');
1430
        $error = substr($error, 0, $at_pos);
1431
        $error =~ s/\s+$//;
1432
        croak "$error$append";
1433
    }
1434
}
1435

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1438
sub _need_tables {
1439
    my ($self, $tree, $need_tables, $tables) = @_;
1440
    
cleanup
Yuki Kimoto authored on 2011-04-02
1441
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1442
    foreach my $table (@$tables) {
1443
        if ($tree->{$table}) {
1444
            $need_tables->{$table} = 1;
1445
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1446
        }
1447
    }
1448
}
1449

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1450
sub _push_join {
1451
    my ($self, $sql, $join, $join_tables) = @_;
1452
    
cleanup
Yuki Kimoto authored on 2011-04-02
1453
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1454
    return unless @$join;
1455
    
cleanup
Yuki Kimoto authored on 2011-04-02
1456
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1457
    my $tree = {};
1458
    for (my $i = 0; $i < @$join; $i++) {
1459
        
cleanup
Yuki Kimoto authored on 2011-07-28
1460
        # Arrange
added join new syntax
Yuki Kimoto authored on 2011-07-28
1461
        my $join_clause;;
1462
        my $option;
1463
        if (ref $join->[$i] eq 'HASH') {
1464
            $join_clause = $join->[$i]->{clause};
1465
            $option = {table => $join->[$i]->{table}};
1466
        }
1467
        else {
1468
            $join_clause = $join->[$i];
1469
            $option = {};
1470
        };
cleanup
Yuki Kimoto authored on 2011-07-28
1471

            
1472
        # Find tables in join clause
added join new syntax
Yuki Kimoto authored on 2011-07-28
1473
        my $table1;
1474
        my $table2;
1475
        if (my $table = $option->{table}) {
1476
            $table1 = $table->[0];
1477
            $table2 = $table->[1];
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1478
        }
cleanup
Yuki Kimoto authored on 2011-07-28
1479
        else {
1480
            my $q = $self->_quote;
1481
            my $j_clause = (split /\s+on\s+/, $join_clause)[-1];
1482
            $j_clause =~ s/'.+?'//g;
1483
            my $q_re = quotemeta($q);
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1484
            $j_clause =~ s/[$q_re]//g;
cleanup
Yuki Kimoto authored on 2011-07-28
1485
            my $c = $self->safety_character;
1486
            my $join_re = qr/(?:^|\s)($c+)\.$c+\s+=\s+($c+)\.$c+/;
1487
            if ($j_clause =~ $join_re) {
1488
                $table1 = $1;
1489
                $table2 = $2;
1490
            }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1491
        }
added join new syntax
Yuki Kimoto authored on 2011-07-28
1492
        croak qq{join clause must have two table name after "on" keyword. } .
1493
              qq{"$join_clause" is passed }  . _subname
1494
          unless defined $table1 && defined $table2;
1495
        croak qq{right side table of "$join_clause" must be unique }
1496
            . _subname
1497
          if exists $tree->{$table2};
1498
        croak qq{Same table "$table1" is specified} . _subname
1499
          if $table1 eq $table2;
1500
        $tree->{$table2}
1501
          = {position => $i, parent => $table1, join => $join_clause};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1502
    }
1503
    
cleanup
Yuki Kimoto authored on 2011-04-02
1504
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1505
    my $need_tables = {};
1506
    $self->_need_tables($tree, $need_tables, $join_tables);
1507
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1508
    
1509
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1510
    foreach my $need_table (@need_tables) {
1511
        push @$sql, $tree->{$need_table}{join};
1512
    }
1513
}
cleanup
Yuki Kimoto authored on 2011-03-08
1514

            
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1515
sub _quote {
1516
    my $self = shift;
1517
    
1518
    return defined $self->reserved_word_quote ? $self->reserved_word_quote
1519
         : defined $self->quote ? $self->quote
1520
         : '';
1521
}
1522

            
cleanup
Yuki Kimoto authored on 2011-07-29
1523
sub _q {
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1524
    my ($self, $value, $quotemeta) = @_;
cleanup
Yuki Kimoto authored on 2011-07-29
1525
    
1526
    my $quote = $self->_quote;
1527
    my $q = substr($quote, 0, 1) || '';
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1528
    my $p;
1529
    if (defined $quote && length $quote > 1) {
1530
        $p = substr($quote, 1, 1);
1531
    }
1532
    else { $p = $q }
cleanup
Yuki Kimoto authored on 2011-07-29
1533
    
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1534
    if ($quotemeta) {
1535
        $q = quotemeta($q);
1536
        $p = quotemeta($p);
1537
    }
1538
    
added quote method's two cha...
Yuki Kimoto authored on 2011-07-29
1539
    return "$q$value$p";
cleanup
Yuki Kimoto authored on 2011-07-29
1540
}
1541

            
cleanup
Yuki Kimoto authored on 2011-04-02
1542
sub _remove_duplicate_table {
1543
    my ($self, $tables, $main_table) = @_;
1544
    
1545
    # Remove duplicate table
1546
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1547
    delete $tables{$main_table} if $main_table;
1548
    
micro optimization
Yuki Kimoto authored on 2011-07-30
1549
    my $new_tables = [keys %tables, $main_table ? $main_table : ()];
1550
    if (my $q = $self->_quote) {
1551
        $q = quotemeta($q);
1552
        $_ =~ s/[$q]//g for @$new_tables;
1553
    }
1554

            
1555
    return $new_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1556
}
1557

            
cleanup
Yuki Kimoto authored on 2011-04-02
1558
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1559
    my ($self, $source) = @_;
1560
    
cleanup
Yuki Kimoto authored on 2011-04-02
1561
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1562
    my $tables = [];
1563
    my $safety_character = $self->safety_character;
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1564
    my $q = $self->_quote;
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1565
    my $quoted_safety_character_re = $self->_q("?([$safety_character]+)", 1);
1566
    my $table_re = $q ? qr/(?:^|[^$safety_character])${quoted_safety_character_re}?\./
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1567
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1568
    while ($source =~ /$table_re/g) {
1569
        push @$tables, $1;
1570
    }
1571
    
1572
    return $tables;
1573
}
1574

            
cleanup
Yuki Kimoto authored on 2011-04-02
1575
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1576
    my ($self, $where) = @_;
1577
    
cleanup
Yuki Kimoto authored on 2011-04-02
1578
    my $obj;
1579
    
1580
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1581
    if (ref $where eq 'HASH') {
1582
        my $clause = ['and'];
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1583
        my $q = $self->_quote;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1584
        foreach my $column (keys %$where) {
fixex [] reserved_word_quote...
Yuki Kimoto authored on 2011-08-14
1585
            my $table;
1586
            my $c;
1587
            if ($column =~ /(?:(.*?)\.)?(.*)/) {
1588
                $table = $1;
1589
                $c = $2;
1590
            }
1591
            
1592
            my $table_quote;
1593
            $table_quote = $self->_q($table) if defined $table;
1594
            my $column_quote = $self->_q($c);
1595
            $column_quote = $table_quote . '.' . $column_quote
1596
              if defined $table_quote;
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1597
            push @$clause, "$column_quote = :$column" for keys %$where;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1598
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1599
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1600
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1601
    
1602
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1603
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1604
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1605
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1606
    
updated pod
Yuki Kimoto authored on 2011-06-21
1607
    # Array
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1608
    elsif (ref $where eq 'ARRAY') {
cleanup
Yuki Kimoto authored on 2011-04-02
1609
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1610
            clause => $where->[0],
1611
            param  => $where->[1]
1612
        );
1613
    }
1614
    
cleanup
Yuki Kimoto authored on 2011-04-02
1615
    # Check where argument
improved error messages
Yuki Kimoto authored on 2011-04-18
1616
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
DBIx::Custom::Model type att...
Yuki Kimoto authored on 2011-06-17
1617
        . qq{or array reference, which contains where clause and parameter}
cleanup
Yuki Kimoto authored on 2011-04-25
1618
        . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1619
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1620
    
cleanup
Yuki Kimoto authored on 2011-04-02
1621
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1622
}
1623

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

            
1627
    # Initialize filters
1628
    $self->{filter} ||= {};
micro optimization
Yuki Kimoto authored on 2011-07-30
1629
    $self->{filter}{on} = 1;
updated pod
Yuki Kimoto authored on 2011-06-21
1630
    $self->{filter}{out} ||= {};
1631
    $self->{filter}{in} ||= {};
1632
    $self->{filter}{end} ||= {};
1633
    
1634
    # Usage
1635
    my $usage = "Usage: \$dbi->apply_filter(" .
1636
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
1637
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
1638
    
1639
    # Apply filter
1640
    for (my $i = 0; $i < @cinfos; $i += 2) {
1641
        
1642
        # Column
1643
        my $column = $cinfos[$i];
1644
        if (ref $column eq 'ARRAY') {
1645
            foreach my $c (@$column) {
1646
                push @cinfos, $c, $cinfos[$i + 1];
1647
            }
1648
            next;
1649
        }
1650
        
1651
        # Filter infomation
1652
        my $finfo = $cinfos[$i + 1] || {};
1653
        croak "$usage (table: $table) " . _subname
1654
          unless  ref $finfo eq 'HASH';
1655
        foreach my $ftype (keys %$finfo) {
1656
            croak "$usage (table: $table) " . _subname
1657
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
1658
        }
1659
        
1660
        # Set filters
1661
        foreach my $way (qw/in out end/) {
1662
        
1663
            # Filter
1664
            my $filter = $finfo->{$way};
1665
            
1666
            # Filter state
1667
            my $state = !exists $finfo->{$way} ? 'not_exists'
1668
                      : !defined $filter        ? 'not_defined'
1669
                      : ref $filter eq 'CODE'   ? 'code'
1670
                      : 'name';
1671
            
1672
            # Filter is not exists
1673
            next if $state eq 'not_exists';
1674
            
1675
            # Check filter name
1676
            croak qq{Filter "$filter" is not registered } . _subname
1677
              if  $state eq 'name'
1678
               && ! exists $self->filters->{$filter};
1679
            
1680
            # Set filter
1681
            my $f = $state eq 'not_defined' ? undef
1682
                  : $state eq 'code'        ? $filter
1683
                  : $self->filters->{$filter};
1684
            $self->{filter}{$way}{$table}{$column} = $f;
1685
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
1686
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
1687
            $self->{filter}{$way}{$table}{"${table}-$column"} = $f;
1688
        }
1689
    }
1690
    
1691
    return $self;
1692
}
1693

            
1694
# DEPRECATED!
1695
sub create_query {
1696
    warn "create_query is DEPRECATED! use query option of each method";
1697
    shift->_create_query(@_);
1698
}
1699

            
cleanup
Yuki Kimoto authored on 2011-06-13
1700
# DEPRECATED!
1701
sub apply_filter {
1702
    my $self = shift;
1703
    
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
1704
    warn "apply_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-06-13
1705
    return $self->_apply_filter(@_);
1706
}
1707

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1708
# DEPRECATED!
simplified arguments check
Yuki Kimoto authored on 2011-07-11
1709
our %SELECT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1710
sub select_at {
1711
    my ($self, %args) = @_;
1712

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

            
select_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1715
    # Arguments
1716
    my $primary_keys = delete $args{primary_key};
1717
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1718
    my $where = delete $args{where};
1719
    my $param = delete $args{param};
1720
    
1721
    # Check arguments
1722
    foreach my $name (keys %args) {
1723
        croak qq{"$name" is wrong option } . _subname
1724
          unless $SELECT_AT_ARGS{$name};
1725
    }
1726
    
1727
    # Table
1728
    croak qq{"table" option must be specified } . _subname
1729
      unless $args{table};
1730
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
1731
    
1732
    # Create where parameter
1733
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1734
    
1735
    return $self->select(where => $where_param, %args);
1736
}
1737

            
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1738
# DEPRECATED!
simplified arguments check
Yuki Kimoto authored on 2011-07-11
1739
our %DELETE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1740
sub delete_at {
1741
    my ($self, %args) = @_;
updated pod
Yuki Kimoto authored on 2011-06-08
1742

            
1743
    warn "delete_at is DEPRECATED! use update and id option instead";
delete_at is DEPRECATED! use...
Yuki Kimoto authored on 2011-06-08
1744
    
1745
    # Arguments
1746
    my $primary_keys = delete $args{primary_key};
1747
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1748
    my $where = delete $args{where};
1749
    
1750
    # Check arguments
1751
    foreach my $name (keys %args) {
1752
        croak qq{"$name" is wrong option } . _subname
1753
          unless $DELETE_AT_ARGS{$name};
1754
    }
1755
    
1756
    # Create where parameter
1757
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1758
    
1759
    return $self->delete(where => $where_param, %args);
1760
}
1761

            
cleanup
Yuki Kimoto authored on 2011-06-08
1762
# DEPRECATED!
simplified arguments check
Yuki Kimoto authored on 2011-07-11
1763
our %UPDATE_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
cleanup
Yuki Kimoto authored on 2011-06-08
1764
sub update_at {
1765
    my $self = shift;
1766

            
1767
    warn "update_at is DEPRECATED! use update and id option instead";
1768
    
1769
    # Arguments
1770
    my $param;
1771
    $param = shift if @_ % 2;
1772
    my %args = @_;
1773
    my $primary_keys = delete $args{primary_key};
1774
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1775
    my $where = delete $args{where};
1776
    my $p = delete $args{param} || {};
1777
    $param  ||= $p;
1778
    
1779
    # Check arguments
1780
    foreach my $name (keys %args) {
1781
        croak qq{"$name" is wrong option } . _subname
1782
          unless $UPDATE_AT_ARGS{$name};
1783
    }
1784
    
1785
    # Create where parameter
1786
    my $where_param = $self->_create_param_from_id($where, $primary_keys);
1787
    
1788
    return $self->update(where => $where_param, param => $param, %args);
1789
}
1790

            
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1791
# DEPRECATED!
simplified arguments check
Yuki Kimoto authored on 2011-07-11
1792
our %INSERT_AT_ARGS = (%VALID_ARGS, where => 1, primary_key => 1);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1793
sub insert_at {
1794
    my $self = shift;
1795
    
1796
    warn "insert_at is DEPRECATED! use insert and id option instead";
1797
    
1798
    # Arguments
1799
    my $param;
1800
    $param = shift if @_ % 2;
1801
    my %args = @_;
1802
    my $primary_key = delete $args{primary_key};
1803
    $primary_key = [$primary_key] unless ref $primary_key;
1804
    my $where = delete $args{where};
1805
    my $p = delete $args{param} || {};
1806
    $param  ||= $p;
1807
    
1808
    # Check arguments
1809
    foreach my $name (keys %args) {
1810
        croak qq{"$name" is wrong option } . _subname
1811
          unless $INSERT_AT_ARGS{$name};
1812
    }
1813
    
1814
    # Create where parameter
cleanup
Yuki Kimoto authored on 2011-06-08
1815
    my $where_param = $self->_create_param_from_id($where, $primary_key);
insert_at is DEPRECATED! add...
Yuki Kimoto authored on 2011-06-08
1816
    $param = $self->merge_param($where_param, $param);
1817
    
1818
    return $self->insert(param => $param, %args);
1819
}
1820

            
added warnings
Yuki Kimoto authored on 2011-06-07
1821
# DEPRECATED!
1822
sub register_tag {
test cleanup
Yuki Kimoto authored on 2011-08-10
1823
    my $self = shift;
1824
    
added warnings
Yuki Kimoto authored on 2011-06-07
1825
    warn "register_tag is DEPRECATED!";
test cleanup
Yuki Kimoto authored on 2011-08-10
1826
    
1827
    # Merge tag
1828
    my $tags = ref $_[0] eq 'HASH' ? $_[0] : {@_};
1829
    $self->{_tags} = {%{$self->{_tags} || {}}, %$tags};
1830
    
1831
    return $self;
1832
}
1833

            
1834
# DEPRECATED!
1835
sub register_tag_processor {
1836
    my $self = shift;
1837
    warn "register_tag_processor is DEPRECATED!";
1838
    # Merge tag
1839
    my $tag_processors = ref $_[0] eq 'HASH' ? $_[0] : {@_};
1840
    $self->{_tags} = {%{$self->{_tags} || {}}, %{$tag_processors}};
1841
    return $self;
added warnings
Yuki Kimoto authored on 2011-06-07
1842
}
1843

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1844
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-06-13
1845
has 'data_source';
reserved_word_quote is DEPRE...
Yuki Kimoto authored on 2011-06-17
1846
has dbi_options => sub { {} };
1847
has filter_check  => 1;
1848
has 'reserved_word_quote';
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1849

            
cleanup
Yuki Kimoto authored on 2011-01-25
1850
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1851
sub default_bind_filter {
1852
    my $self = shift;
1853
    
cleanup
Yuki Kimoto authored on 2011-06-13
1854
    warn "default_bind_filter is DEPRECATED!";
added warnings
Yuki Kimoto authored on 2011-06-07
1855
    
cleanup
Yuki Kimoto authored on 2011-01-12
1856
    if (@_) {
1857
        my $fname = $_[0];
1858
        
1859
        if (@_ && !$fname) {
1860
            $self->{default_out_filter} = undef;
1861
        }
1862
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1863
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1864
              unless exists $self->filters->{$fname};
1865
        
1866
            $self->{default_out_filter} = $self->filters->{$fname};
1867
        }
1868
        return $self;
1869
    }
1870
    
1871
    return $self->{default_out_filter};
1872
}
1873

            
cleanup
Yuki Kimoto authored on 2011-01-25
1874
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1875
sub default_fetch_filter {
1876
    my $self = shift;
added warnings
Yuki Kimoto authored on 2011-06-07
1877

            
cleanup
Yuki Kimoto authored on 2011-06-13
1878
    warn "default_fetch_filter is DEPRECATED!";
cleanup
Yuki Kimoto authored on 2011-01-12
1879
    
1880
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1881
        my $fname = $_[0];
1882

            
cleanup
Yuki Kimoto authored on 2011-01-12
1883
        if (@_ && !$fname) {
1884
            $self->{default_in_filter} = undef;
1885
        }
1886
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1887
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1888
              unless exists $self->filters->{$fname};
1889
        
1890
            $self->{default_in_filter} = $self->filters->{$fname};
1891
        }
1892
        
1893
        return $self;
1894
    }
1895
    
many changed
Yuki Kimoto authored on 2011-01-23
1896
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1897
}
1898

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1899
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1900
sub insert_param_tag {
1901
    warn "insert_param_tag is DEPRECATED! " .
1902
         "use insert_param instead!";
1903
    return shift->insert_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1904
}
1905

            
1906
# DEPRECATED!
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1907
sub update_param_tag {
fixed DEPRECATED message bug
Yuki Kimoto authored on 2011-06-10
1908
    warn "update_param_tag is DEPRECATED! " .
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
1909
         "use update_param instead";
1910
    return shift->update_param(@_);
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1911
}
cleanup
Yuki Kimoto authored on 2011-03-08
1912
# DEPRECATED!
1913
sub _push_relation {
1914
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1915
    
1916
    if (keys %{$relation || {}}) {
1917
        push @$sql, $need_where ? 'where' : 'and';
1918
        foreach my $rcolumn (keys %$relation) {
1919
            my $table1 = (split (/\./, $rcolumn))[0];
1920
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1921
            push @$tables, ($table1, $table2);
1922
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1923
        }
1924
    }
1925
    pop @$sql if $sql->[-1] eq 'and';    
1926
}
1927

            
1928
# DEPRECATED!
1929
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1930
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1931
    
1932
    if (keys %{$relation || {}}) {
1933
        foreach my $rcolumn (keys %$relation) {
1934
            my $table1 = (split (/\./, $rcolumn))[0];
1935
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1936
            my $table1_exists;
1937
            my $table2_exists;
1938
            foreach my $table (@$tables) {
1939
                $table1_exists = 1 if $table eq $table1;
1940
                $table2_exists = 1 if $table eq $table2;
1941
            }
1942
            unshift @$tables, $table1 unless $table1_exists;
1943
            unshift @$tables, $table2 unless $table2_exists;
1944
        }
1945
    }
1946
}
1947

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1950
=head1 NAME
1951

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

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1956
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1957
    
1958
    # Connect
1959
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1960
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1961
        user => 'ken',
1962
        password => '!LFKD%$&',
1963
        dbi_option => {mysql_enable_utf8 => 1}
1964
    );
cleanup
yuki-kimoto authored on 2010-08-05
1965

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1966
    # Insert 
updated pod
Yuki Kimoto authored on 2011-06-21
1967
    $dbi->insert({title => 'Perl', author => 'Ken'}, table  => 'book');
removed reconnect method
yuki-kimoto authored on 2010-05-28
1968
    
1969
    # Update 
updated pod
Yuki Kimoto authored on 2011-06-21
1970
    $dbi->update({title => 'Perl', author => 'Ken'}, table  => 'book',
1971
      where  => {id => 5});
removed reconnect method
yuki-kimoto authored on 2010-05-28
1972
    
1973
    # Delete
updated pod
Yuki Kimoto authored on 2011-06-21
1974
    $dbi->delete(table  => 'book', where => {author => 'Ken'});
cleanup
yuki-kimoto authored on 2010-08-05
1975

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1980
    # Select, more complex
1981
    my $result = $dbi->select(
1982
        table  => 'book',
1983
        column => [
cleanup
Yuki Kimoto authored on 2011-06-13
1984
            {book => [qw/title author/]},
1985
            {company => ['name']}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1986
        ],
1987
        where  => {'book.author' => 'Ken'},
1988
        join => ['left outer join company on book.company_id = company.id'],
1989
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1990
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1991
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1992
    # Fetch
1993
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1994
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1995
    }
1996
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1997
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1998
    while (my $row = $result->fetch_hash) {
1999
        
2000
    }
2001
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2002
    # Execute SQL with parameter.
2003
    $dbi->execute(
- update_param_tag is DEPREC...
Yuki Kimoto authored on 2011-06-07
2004
        "select id from book where author = :author and title like :title",
updated pod
Yuki Kimoto authored on 2011-06-21
2005
        {author => 'ken', title => '%Perl%'}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2006
    );
2007
    
fix heading typos
Terrence Brannon authored on 2011-08-17
2008
=head1 DESCRIPTION
removed reconnect method
yuki-kimoto authored on 2010-05-28
2009

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

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

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

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

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

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

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

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2025
Named place holder support
2026

            
2027
=item *
2028

            
cleanup
Yuki Kimoto authored on 2011-07-29
2029
Model support
2030

            
2031
=item *
2032

            
2033
Connection manager support
2034

            
2035
=item *
pod fix
Yuki Kimoto authored on 2011-01-21
2036

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

            
2041
=item *
2042

            
2043
Filtering by data type or column name(EXPERIMENTAL)
2044

            
2045
=item *
2046

            
2047
Create C<order by> clause flexibly(EXPERIMENTAL)
2048

            
2049
=back
pod fix
Yuki Kimoto authored on 2011-01-21
2050

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

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

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

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2058
Module documentations - 
cleanup
Yuki Kimoto authored on 2011-07-29
2059
L<DBIx::Custom::Result>,
2060
L<DBIx::Custom::Query>,
2061
L<DBIx::Custom::Where>,
2062
L<DBIx::Custom::Model>,
2063
L<DBIx::Custom::Order>
updated document
yuki-kimoto authored on 2010-08-08
2064

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

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

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

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

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

            
2078
    my $connector = DBIx::Connector->new(
cleanup
Yuki Kimoto authored on 2011-08-16
2079
        "dbi:mysql:database=$database",
2080
        $user,
2081
        $password,
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2082
        DBIx::Custom->new->default_dbi_option
2083
    );
2084
    
updated pod
Yuki Kimoto authored on 2011-06-21
2085
    my $dbi = DBIx::Custom->connect(connector => $connector);
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
2086

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

            
2090
    my $dbi = DBIx::Custom->connect(
2091
      dsn => $dsn, user => $user, password => $password, connector => 1);
2092
    
2093
    my $connector = $dbi->connector; # DBIx::Connector
2094

            
2095
Note that L<DBIx::Connector> must be installed.
2096

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

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

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

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

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

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

            
2112
=head2 C<default_dbi_option>
2113

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
2120
    {
2121
        RaiseError => 1,
2122
        PrintError => 0,
2123
        AutoCommit => 1,
2124
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
2125

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

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

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

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

            
2135
    my $last_sql = $dbi->last_sql;
2136
    $dbi = $dbi->last_sql($last_sql);
2137

            
2138
Get last successed SQL executed by C<execute> method.
2139

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2147
=head2 C<password>
2148

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-07-30
2169
You can set quote pair.
2170

            
2171
    $dbi->quote('[]');
2172

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

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

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

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

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

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

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

            
2190
    my $separator = $self->separator;
2191
    $dbi = $self->separator($separator);
2192

            
2193
Separator whichi join table and column.
2194
This is used by C<column> and C<mycolumn> method.
2195

            
renamed system_table to excl...
Yuki Kimoto authored on 2011-08-10
2196
=head2 C<exclude_table EXPERIMENTAL>
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
2197

            
renamed system_table to excl...
Yuki Kimoto authored on 2011-08-10
2198
    my $exclude_table = $self->exclude_table;
2199
    $dbi = $self->exclude_table(qr/pg_/);
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
2200

            
2201
Regex matching system table.
2202
this regex match is used by C<each_table> method and C<each_column> method
2203
System table is ignored.
2204
C<type_rule> method and C<setup_model> method call
renamed system_table to excl...
Yuki Kimoto authored on 2011-08-10
2205
C<each_table>, so if you set C<exclude_table> properly,
added EXPERIMENTAL system_ta...
Yuki Kimoto authored on 2011-08-10
2206
The performance is up.
2207

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

            
2210
    my $tag_parse = $dbi->tag_parse(0);
2211
    $dbi = $dbi->tag_parse;
2212

            
2213
Enable DEPRECATED tag parsing functionality, default to 1.
2214
If you want to disable tag parsing functionality, set to 0.
2215

            
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
2216
=head2 C<timestamp EXPERIMENTAL>
2217

            
2218
    my $timestamp = $dbi->timestamp($timestamp);
2219
    $dbi = $dbi->timestamp;
2220

            
2221
Timestamp information.
2222

            
2223
    $dbi->timestamp({
2224
        insert => [created_at => 'NOW()'],
2225
        update => [updated_at => 'NOW()']
2226
    });
2227

            
2228
This value is used when C<insert> or C<update> method's C<timestamp>
2229
option is specified.
2230

            
2231
C<insert> is used by C<insert> method, and C<update> is
2232
used by C<update> method.
2233

            
2234
Key, such as C<create_at> is column name.
2235
value such as C<NOW()> is DB function.
2236

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

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

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

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2244
=head2 C<user_column_info EXPERIMENTAL>
2245

            
2246
    my $user_column_info = $dbi->user_column_info;
2247
    $dbi = $dbi->user_column_info($user_column_info);
2248

            
2249
You can set the following data.
2250

            
2251
    [
2252
        {table => 'book', column => 'title', info => {...}},
2253
        {table => 'author', column => 'name', info => {...}}
2254
    ]
2255

            
2256
Usually, you can set return value of C<get_column_info>.
2257

            
2258
    my $user_column_info
2259
      = $dbi->get_column_info(exclude_table => qr/^system/);
2260
    $dbi->user_column_info($user_column_info);
2261

            
2262
If C<user_column_info> is set, C<each_column> use C<user_column_info>
2263
to find column info.
2264

            
added test
Yuki Kimoto authored on 2011-08-16
2265
=head2 C<user_table_info EXPERIMENTAL>
2266

            
2267
    my $user_table_info = $dbi->user_table_info;
2268
    $dbi = $dbi->user_table_info($user_table_info);
2269

            
2270
You can set the following data.
2271

            
2272
    [
2273
        {table => 'book', info => {...}},
2274
        {table => 'author', info => {...}}
2275
    ]
2276

            
2277
Usually, you can set return value of C<get_table_info>.
2278

            
2279
    my $user_table_info = $dbi->get_table_info(exclude => qr/^system/);
2280
    $dbi->user_table_info($user_table_info);
2281

            
2282
If C<user_table_info> is set, C<each_table> use C<user_table_info>
2283
to find table info.
2284

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

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

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
2291
=head2 C<available_datatype> EXPERIMENTAL
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
2292

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

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

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
2298
=head2 C<available_typename> EXPERIMENTAL
added EXPERIMENTAL available...
Yuki Kimoto authored on 2011-06-14
2299

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

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

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

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

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

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

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

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

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

            
2319
Create column clause. The follwoing column clause is created.
2320

            
2321
    book.author as "book.author",
2322
    book.title as "book.title"
2323

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
2326
    # Separator is double underbar
2327
    $dbi->separator('__');
2328
    
2329
    book.author as "book__author",
2330
    book.title as "book__title"
- select() EXPERIMETNAL colu...
Yuki Kimoto authored on 2011-06-08
2331

            
cleanup
Yuki Kimoto authored on 2011-06-13
2332
    # Separator is hyphen
2333
    $dbi->separator('-');
2334
    
2335
    book.author as "book-author",
2336
    book.title as "book-title"
2337
    
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2338
=head2 C<connect>
packaging one directory
yuki-kimoto authored on 2009-11-16
2339

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

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

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

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-08-20
2353
=head2 C<count> EXPERIMENTAL
2354

            
2355
    my $count = $model->count(table => 'book');
2356

            
2357
Get rows count.
2358

            
2359
Options is same as C<select> method's ones.
2360

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
2363
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2364
        table => 'book',
2365
        primary_key => 'id',
2366
        join => [
2367
            'inner join company on book.comparny_id = company.id'
2368
        ],
2369
    );
2370

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

            
2374
   $dbi->model('book')->select(...);
2375

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

            
2378
    my $dbh = $dbi->dbh;
2379

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

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

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

            
2387
Execute delete statement.
2388

            
2389
The following opitons are available.
2390

            
2391
=over 4
2392

            
2393
=item C<append>
2394

            
2395
Same as C<select> method's C<append> option.
2396

            
2397
=item C<filter>
2398

            
2399
Same as C<execute> method's C<filter> option.
2400

            
2401
=item C<id>
2402

            
2403
    id => 4
2404
    id => [4, 5]
2405

            
2406
ID corresponding to C<primary_key>.
2407
You can delete rows by C<id> and C<primary_key>.
2408

            
2409
    $dbi->delete(
2410
        parimary_key => ['id1', 'id2'],
2411
        id => [4, 5],
2412
        table => 'book',
2413
    );
2414

            
2415
The above is same as the followin one.
2416

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

            
2419
=item C<prefix>
2420

            
2421
    prefix => 'some'
2422

            
2423
prefix before table name section.
2424

            
2425
    delete some from book
2426

            
2427
=item C<query>
2428

            
2429
Same as C<execute> method's C<query> option.
2430

            
2431
=item C<sqlfilter EXPERIMENTAL>
2432

            
2433
Same as C<execute> method's C<sqlfilter> option.
2434

            
2435
=item C<table>
2436

            
2437
    table => 'book'
2438

            
2439
Table name.
2440

            
2441
=item C<where>
2442

            
2443
Same as C<select> method's C<where> option.
2444

            
2445
=item C<primary_key>
2446

            
2447
See C<id> option.
2448

            
2449
=item C<bind_type>
2450

            
2451
Same as C<execute> method's C<bind_type> option.
2452

            
2453
=item C<type_rule_off> EXPERIMENTAL
2454

            
2455
Same as C<execute> method's C<type_rule_off> option.
2456

            
2457
=item C<type_rule1_off> EXPERIMENTAL
2458

            
2459
    type_rule1_off => 1
2460

            
2461
Same as C<execute> method's C<type_rule1_off> option.
2462

            
2463
=item C<type_rule2_off> EXPERIMENTAL
2464

            
2465
    type_rule2_off => 1
2466

            
2467
Same as C<execute> method's C<type_rule2_off> option.
2468

            
2469
=back
2470

            
2471
=head2 C<delete_all>
2472

            
2473
    $dbi->delete_all(table => $table);
2474

            
2475
Execute delete statement for all rows.
2476
Options is same as C<delete>.
2477

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

            
2480
    $dbi->each_column(
2481
        sub {
2482
            my ($dbi, $table, $column, $column_info) = @_;
2483
            
2484
            my $type = $column_info->{TYPE_NAME};
2485
            
2486
            if ($type eq 'DATE') {
2487
                # ...
2488
            }
2489
        }
2490
    );
2491

            
2492
Iterate all column informations of all table from database.
2493
Argument is callback when one column is found.
2494
Callback receive four arguments, dbi object, table name,
2495
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
2496

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

            
2499
    $dbi->each_table(
2500
        sub {
2501
            my ($dbi, $table, $table_info) = @_;
2502
            
2503
            my $table_name = $table_info->{TABLE_NAME};
2504
        }
2505
    );
2506

            
2507
Iterate all table informationsfrom database.
2508
Argument is callback when one table is found.
2509
Callback receive three arguments, dbi object, table name,
2510
table information.
2511

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

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

            
2519
    my $result = $dbi->execute(
2520
      "select * from book where title = :book.title and author like :book.author",
2521
      {'book.title' => 'Perl', 'book.author' => '%Ken%'}
update pod
Yuki Kimoto authored on 2011-03-13
2522
    );
2523

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

            
I call :title named placehol...
Yuki Kimoto authored on 2011-07-30
2530
Named placeholder such as C<:title> is replaced by placeholder C<?>.
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2531
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2532
    # Original
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2533
    select * from book where title = :title and author like :author
2534
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2535
    # Replaced
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2536
    select * from where title = ? and author like ?;
update pod
Yuki Kimoto authored on 2011-03-13
2537

            
I call :title named placehol...
Yuki Kimoto authored on 2011-07-30
2538
You can specify operator with named placeholder
2539
 by C<name{operator}> syntax.
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2540

            
micro optimization
Yuki Kimoto authored on 2011-07-30
2541
    # Original
added EXPERIMENTAL parameter...
Yuki Kimoto authored on 2011-07-29
2542
    select * from book where :title{=} and :author{like}
2543
    
micro optimization
Yuki Kimoto authored on 2011-07-30
2544
    # Replaced
update pod
Yuki Kimoto authored on 2011-03-13
2545
    select * from where title = ? and author like ?;
2546

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

            
2551
    select * from where title = "aa\\:bb";
2552

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

            
2555
=over 4
2556

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

            
2559
Specify database bind data type.
2560

            
2561
    bind_type => [image => DBI::SQL_BLOB]
2562
    bind_type => [[qw/image audio/] => DBI::SQL_BLOB]
2563

            
2564
This is used to bind parameter by C<bind_param> of statment handle.
2565

            
2566
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2567

            
update pod
Yuki Kimoto authored on 2011-03-13
2568
=item C<filter>
updated pod
Yuki Kimoto authored on 2011-06-09
2569
    
2570
    filter => {
2571
        title  => sub { uc $_[0] }
2572
        author => sub { uc $_[0] }
2573
    }
update pod
Yuki Kimoto authored on 2011-03-13
2574

            
updated pod
Yuki Kimoto authored on 2011-06-09
2575
    # Filter name
2576
    filter => {
2577
        title  => 'upper_case',
2578
        author => 'upper_case'
2579
    }
2580
        
2581
    # At once
2582
    filter => [
2583
        [qw/title author/]  => sub { uc $_[0] }
2584
    ]
2585

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

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

            
2593
    id => 4
2594
    id => [4, 5]
2595

            
2596
ID corresponding to C<primary_key>.
2597
You can delete rows by C<id> and C<primary_key>.
2598

            
2599
    $dbi->execute(
2600
        "select * from book where id1 = :id1 and id2 = :id2",
2601
        {},
2602
        parimary_key => ['id1', 'id2'],
2603
        id => [4, 5],
2604
    );
2605

            
2606
The above is same as the followin one.
2607

            
2608
    $dbi->execute(
2609
        "select * from book where id1 = :id1 and id2 = :id2",
2610
        {id1 => 4, id2 => 5}
2611
    );
2612

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

            
2615
    query => 1
2616

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

            
2620
    my $sql = $query->sql;
cleanup
Yuki Kimoto authored on 2011-07-30
2621
    my $sth = $query->sth;
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2622
    my $columns = $query->columns;
2623
    
2624
If you want to execute SQL fast, you can do the following way.
2625

            
2626
    my $query;
2627
    foreach my $row (@$rows) {
2628
      $query ||= $dbi->insert($row, table => 'table1', query => 1);
2629
      $dbi->execute($query, $row, filter => {ab => sub { $_[0] * 2 }});
2630
    }
2631

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

            
2635
If you want to execute SQL as possible as fast and don't need filtering.
Added execute method's query...
Yuki Kimoto authored on 2011-07-30
2636
You can do the following way.
cleanup
Yuki Kimoto authored on 2011-07-30
2637
    
2638
    my $query;
2639
    my $sth;
2640
    foreach my $row (@$rows) {
2641
      $query ||= $dbi->insert($row, table => 'book', query => 1);
2642
      $sth ||= $query->sth;
2643
      $sth->execute(map { $row->{$_} } sort keys %$row);
2644
    }
2645

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

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

            
2652
See C<id> option.
2653

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
2654
=item C<sqlfilter EXPERIMENTAL> 
2655

            
2656
SQL filter function.
2657

            
2658
    sqlfilter => $code_ref
2659

            
2660
This option is generally for Oracle and SQL Server paging process.
2661
    
2662
    my $limit = sub {
2663
        my ($sql, $count, $offset) = @_;
2664
        
2665
        my $min = $offset + 1;
2666
        my $max = $offset + $count;
2667
        
2668
        $sql = "select * from ( $sql ) as t where rnum >= $min rnum <= $max";
2669
        
2670
        return $sql;
2671
    }
2672
    $dbi->select(... column => ['ROWNUM rnom'], sqlfilter => sub {
2673
        my $sql = shift;
2674
        return $limit->($sql, 100, 50);
2675
    })
2676

            
updated pod
Yuki Kimoto authored on 2011-06-09
2677
=item C<table>
2678
    
2679
    table => 'author'
2680

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

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

            
updated pod
Yuki Kimoto authored on 2011-06-21
2688
    # Same
2689
    $dbi->execute(
2690
      "select * from book where title = :book.title and author = :book.author",
2691
      {title => 'Perl', author => 'Ken');
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2692

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

            
2695
    table_alias => {user => 'hiker'}
2696

            
2697
Table alias. Key is real table name, value is alias table name.
2698
If you set C<table_alias>, you can enable C<into1> and C<into2> type rule
2699
on alias table name.
2700

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

            
2703
    type_rule_off => 1
2704

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

            
2707
=item C<type_rule1_off> EXPERIMENTAL
2708

            
2709
    type_rule1_off => 1
2710

            
2711
Turn C<into1> type rule off.
2712

            
2713
=item C<type_rule2_off> EXPERIMENTAL
2714

            
2715
    type_rule2_off => 1
2716

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

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

            
- added EXPERIMENTAL get_col...
Yuki Kimoto authored on 2011-08-16
2721
=head2 C<get_column_info EXPERIMENTAL>
2722

            
2723
    my $tables = $self->get_column_info(exclude_table => qr/^system_/);
2724

            
2725
get column infomation except for one which match C<exclude_table> pattern.
2726

            
2727
    [
2728
        {table => 'book', column => 'title', info => {...}},
2729
        {table => 'author', column => 'name' info => {...}}
2730
    ]
2731

            
added test
Yuki Kimoto authored on 2011-08-16
2732
=head2 C<get_table_info EXPERIMENTAL>
2733

            
2734
    my $tables = $self->get_table_info(exclude => qr/^system_/);
update pod
Yuki Kimoto authored on 2011-03-13
2735

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

            
2738
    [
2739
        {table => 'book', info => {...}},
2740
        {table => 'author', info => {...}}
2741
    ]
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2742

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2745
=head2 C<insert>
2746

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

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

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

            
2755
    {date => \"NOW()"}
2756

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

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

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

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

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

            
2767
Same as C<execute> method's C<bind_type> option.
2768

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

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

            
2773
=item C<id>
2774

            
updated document
Yuki Kimoto authored on 2011-06-09
2775
    id => 4
2776
    id => [4, 5]
update pod
Yuki Kimoto authored on 2011-03-13
2777

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2781
    $dbi->insert(
updated document
Yuki Kimoto authored on 2011-06-09
2782
        {title => 'Perl', author => 'Ken'}
2783
        parimary_key => ['id1', 'id2'],
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2784
        id => [4, 5],
updated document
Yuki Kimoto authored on 2011-06-09
2785
        table => 'book'
update pod
Yuki Kimoto authored on 2011-03-13
2786
    );
added EXPERIMENTAL execute()...
Yuki Kimoto authored on 2011-06-09
2787

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

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

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

            
2797
    prefix => 'or replace'
2798

            
2799
prefix before table name section
2800

            
2801
    insert or replace into book
2802

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

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

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

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

            
2812
Same as C<execute> method's C<query> option.
2813

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
2814
=item C<sqlfilter EXPERIMENTAL>
2815

            
2816
Same as C<execute> method's C<sqlfilter> option.
2817

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

            
2820
    table => 'book'
2821

            
2822
Table name.
2823

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

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

            
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
2828
=item C<timestamp EXPERIMENTAL>
2829

            
2830
    timestamp => 1
2831

            
2832
If this value is set to 1,
2833
automatically created timestamp column is set based on
2834
C<timestamp> attribute's C<insert> value.
2835

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

            
2838
    type_rule1_off => 1
2839

            
2840
Same as C<execute> method's C<type_rule1_off> option.
2841

            
2842
=item C<type_rule2_off> EXPERIMENTAL
2843

            
2844
    type_rule2_off => 1
2845

            
2846
Same as C<execute> method's C<type_rule2_off> option.
2847

            
updated pod
Yuki Kimoto authored on 2011-09-02
2848
=item C<wrap EXPERIMENTAL>
2849

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

            
2852
placeholder wrapped string.
2853

            
2854
If the following statement
2855

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

            
2859
is executed, the following SQL is executed.
2860

            
2861
    insert into book price values ( ? + 5 );
2862

            
update pod
Yuki Kimoto authored on 2011-03-13
2863
=back
2864

            
2865
=over 4
2866

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2882
    lib / MyModel.pm
2883
        / MyModel / book.pm
2884
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2885

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

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

            
2890
    package MyModel;
updated pod
Yuki Kimoto authored on 2011-06-21
2891
    use DBIx::Custom::Model -base;
update pod
Yuki Kimoto authored on 2011-03-13
2892
    
2893
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2894

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2899
    package MyModel::book;
updated pod
Yuki Kimoto authored on 2011-06-21
2900
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2901
    
2902
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2903

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2906
    package MyModel::company;
updated pod
Yuki Kimoto authored on 2011-06-21
2907
    use MyModel -base;
update pod
Yuki Kimoto authored on 2011-03-13
2908
    
2909
    1;
2910
    
updated pod
Yuki Kimoto authored on 2011-06-21
2911
MyModel::book and MyModel::company is included by C<include_model>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2912

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

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

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

            
- added EXPERIMENTAL pass at...
Yuki Kimoto authored on 2011-09-02
2920
=head2 C<mapper EXPERIMETNAL>
2921

            
2922
    my $mapper = $dbi->mapper(param => $param);
2923

            
2924
Create a new L<DBIx::Custom::Mapper> object.
2925

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

            
2928
    my $map_param = $dbi->map_param(
2929
        {id => 1, authro => 'Ken', price => 1900},
2930
        'id' => 'book.id',
2931
        'author' => ['book.author' => sub { '%' . $_[0] . '%' }],
2932
        'price' => [
2933
            'book.price', {if => sub { length $_[0] }}
2934
        ]
2935
    );
2936

            
2937
Map paramters to other key and value. First argument is original
2938
parameter. this is hash reference. Rest argument is mapping.
2939
By default, Mapping is done if the value length is not zero.
2940

            
2941
=over 4
2942

            
2943
=item Key mapping
2944

            
2945
    'id' => 'book.id'
2946

            
2947
This is only key mapping. Value is same as original one.
2948

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

            
2951
=item Key and value mapping
2952

            
2953
    'author' => ['book.author' => sub { '%' . $_[0] . '%' }]
2954

            
2955
This is key and value mapping. Frist element of array reference
2956
is mapped key name, second element is code reference to map the value.
2957

            
2958
    (author => 'Ken') is mapped to ('book.author' => '%Ken%')
2959
      if value length is not zero.
2960

            
2961
=item Condition
2962

            
2963
    'price' => ['book.price', {if => 'exists'}]
2964
    'price' => ['book.price', sub { '%' . $_[0] . '%' }, {if => 'exists'}]
2965
    'price' => ['book.price', {if => sub { defined shift }}]
2966

            
2967
If you need condition, you can sepecify it. this is code reference
2968
or 'exists'. By default, condition is the following one.
2969

            
2970
    sub { defined $_[0] && length $_[0] }
2971

            
2972
=back
2973

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

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

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

            
2980
    {key1 => [1, 1], key2 => 2}
2981

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

            
2984
    $dbi->method(
2985
        update_or_insert => sub {
2986
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2987
            
2988
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2989
        },
2990
        find_or_create   => sub {
2991
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2992
            
2993
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2994
        }
2995
    );
2996

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

            
2999
    $dbi->update_or_insert;
3000
    $dbi->find_or_create;
3001

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

            
3004
    my $model = $dbi->model('book');
3005

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

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

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

            
3012
Create column clause for myself. The follwoing column clause is created.
3013

            
3014
    book.author as author,
3015
    book.title as title
3016

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

            
update pod
Yuki Kimoto authored on 2011-03-13
3019
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
3020
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
3021
        user => 'ken',
3022
        password => '!LFKD%$&',
3023
        dbi_option => {mysql_enable_utf8 => 1}
3024
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
3025

            
3026
Create a new L<DBIx::Custom> object.
3027

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

            
3030
    my $not_exists = $dbi->not_exists;
3031

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

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

            
3037
    my $order = $dbi->order;
3038

            
3039
Create a new L<DBIx::Custom::Order> object.
3040

            
cleanup
yuki-kimoto authored on 2010-10-17
3041
=head2 C<register_filter>
3042

            
update pod
Yuki Kimoto authored on 2011-03-13
3043
    $dbi->register_filter(
3044
        # Time::Piece object to database DATE format
3045
        tp_to_date => sub {
3046
            my $tp = shift;
3047
            return $tp->strftime('%Y-%m-%d');
3048
        },
3049
        # database DATE format to Time::Piece object
3050
        date_to_tp => sub {
3051
           my $date = shift;
3052
           return Time::Piece->strptime($date, '%Y-%m-%d');
3053
        }
3054
    );
cleanup
yuki-kimoto authored on 2010-10-17
3055
    
update pod
Yuki Kimoto authored on 2011-03-13
3056
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
3057

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

            
3060
    $dbi->type_rule(
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
3061
        into1 => {
separate DBIx::Custom type_r...
Yuki Kimoto authored on 2011-06-15
3062
            date => sub { ... },
3063
            datetime => sub { ... }
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
3064
        },
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
3065
        into2 => {
3066
            date => sub { ... },
3067
            datetime => sub { ... }
3068
        },
3069
        from1 => {
3070
            # DATE
3071
            9 => sub { ... },
3072
            # DATETIME or TIMESTAMP
3073
            11 => sub { ... },
3074
        }
3075
        from2 => {
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
3076
            # DATE
3077
            9 => sub { ... },
3078
            # DATETIME or TIMESTAMP
3079
            11 => sub { ... },
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
3080
        }
3081
    );
3082

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
3098
=over 4
3099

            
3100
=item 1. column name
3101

            
3102
    issue_date
3103
    issue_datetime
3104

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

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

            
3109
    book.issue_date
3110
    book.issue_datetime
3111

            
3112
=back
3113

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
3114
You get all type name used in database by C<available_typename>.
update pod
Yuki Kimoto authored on 2011-06-15
3115

            
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
3116
    print $dbi->available_typename;
update pod
Yuki Kimoto authored on 2011-06-15
3117

            
updated pod
Yuki Kimoto authored on 2011-06-21
3118
In C<from1> and C<from2> you specify data type, not type name.
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
3119
C<from2> is executed after C<from1>.
added EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-08-09
3120
You get all data type by C<available_datatype>.
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
3121

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

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

            
3126
    $dbi->type_rule(
EXPERIMENTAL type_rule argum...
Yuki Kimoto authored on 2011-06-17
3127
        into1 => [
changed type_rule arguments ...
Yuki Kimoto authored on 2011-06-12
3128
            [qw/DATE DATETIME/] => sub { ... },
3129
        ],
3130
    );
added type_rule into logic
Yuki Kimoto authored on 2011-06-09
3131

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
3134
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3135
        table  => 'book',
3136
        column => ['author', 'title'],
3137
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
3138
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3139
    
updated document
Yuki Kimoto authored on 2011-06-09
3140
Execute select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3141

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

            
3144
=over 4
3145

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3150
Append statement to last of SQL.
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
3151

            
3152
=item C<bind_type>
3153

            
3154
Same as C<execute> method's C<bind_type> option.
updated document
Yuki Kimoto authored on 2011-06-09
3155
    
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3156
=item C<column>
3157
    
updated document
Yuki Kimoto authored on 2011-06-09
3158
    column => 'author'
3159
    column => ['author', 'title']
3160

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

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3169
    column => [
updated pod
Yuki Kimoto authored on 2011-06-07
3170
        {book => [qw/author title/]},
3171
        {person => [qw/name age/]}
updated document
Yuki Kimoto authored on 2011-06-09
3172
    ]
updated pod
Yuki Kimoto authored on 2011-06-07
3173

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

            
3176
    book.author as "book.author",
3177
    book.title as "book.title",
3178
    person.name as "person.name",
3179
    person.age as "person.age"
3180

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

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

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

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

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

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

            
3196
=item C<id>
3197

            
3198
    id => 4
3199
    id => [4, 5]
3200

            
3201
ID corresponding to C<primary_key>.
3202
You can select rows by C<id> and C<primary_key>.
3203

            
3204
    $dbi->select(
3205
        parimary_key => ['id1', 'id2'],
3206
        id => [4, 5],
3207
        table => 'book'
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3208
    );
3209

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
3212
    $dbi->select(
updated document
Yuki Kimoto authored on 2011-06-09
3213
        where => {id1 => 4, id2 => 5},
3214
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
3215
    );
3216
    
updated document
Yuki Kimoto authored on 2011-06-09
3217
=item C<param> EXPERIMETNAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
3218

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

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

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

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

            
3231
    prefix => 'SQL_CALC_FOUND_ROWS'
3232

            
3233
Prefix of column cluase
3234

            
3235
    select SQL_CALC_FOUND_ROWS title, author from book;
3236

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

            
3239
    join => [
3240
        'left outer join company on book.company_id = company_id',
3241
        'left outer join location on company.location_id = location.id'
3242
    ]
3243
        
3244
Join clause. If column cluase or where clause contain table name like "company.name",
3245
join clausees needed when SQL is created is used automatically.
update pod
Yuki Kimoto authored on 2011-03-12
3246

            
3247
    $dbi->select(
3248
        table => 'book',
cleanup
Yuki Kimoto authored on 2011-06-13
3249
        column => ['company.location_id as location_id'],
update pod
Yuki Kimoto authored on 2011-03-12
3250
        where => {'company.name' => 'Orange'},
3251
        join => [
3252
            'left outer join company on book.company_id = company.id',
3253
            'left outer join location on company.location_id = location.id'
3254
        ]
3255
    );
3256

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

            
cleanup
Yuki Kimoto authored on 2011-06-13
3260
    select company.location_id as location_id
update pod
Yuki Kimoto authored on 2011-03-12
3261
    from book
3262
      left outer join company on book.company_id = company.id
cleanup
Yuki Kimoto authored on 2011-06-13
3263
    where company.name = ?;
update pod
Yuki Kimoto authored on 2011-03-12
3264

            
added join new syntax
Yuki Kimoto authored on 2011-07-28
3265
You can specify two table by yourself. This is useful when join parser can't parse
cleanup
Yuki Kimoto authored on 2011-07-28
3266
the join clause correctly. This is EXPERIMENTAL.
added join new syntax
Yuki Kimoto authored on 2011-07-28
3267

            
3268
    $dbi->select(
3269
        table => 'book',
3270
        column => ['company.location_id as location_id'],
3271
        where => {'company.name' => 'Orange'},
3272
        join => [
3273
            {
3274
                clause => 'left outer join location on company.location_id = location.id',
3275
                table => ['company', 'location']
3276
            }
3277
        ]
3278
    );
3279

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

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

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

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

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

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
3291
=item C<sqlfilter EXPERIMENTAL>
updated pod
Yuki Kimoto authored on 2011-06-08
3292

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
3293
Same as C<execute> method's C<sqlfilter> option
updated pod
Yuki Kimoto authored on 2011-06-08
3294

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3299
Table name.
updated pod
Yuki Kimoto authored on 2011-06-08
3300

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

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

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

            
3307
    type_rule1_off => 1
3308

            
3309
Same as C<execute> method's C<type_rule1_off> option.
3310

            
3311
=item C<type_rule2_off> EXPERIMENTAL
3312

            
3313
    type_rule2_off => 1
3314

            
3315
Same as C<execute> method's C<type_rule2_off> option.
3316

            
updated document
Yuki Kimoto authored on 2011-06-09
3317
=item C<where>
3318
    
3319
    # Hash refrence
3320
    where => {author => 'Ken', 'title' => 'Perl'}
3321
    
3322
    # DBIx::Custom::Where object
3323
    where => $dbi->where(
3324
        clause => ['and', 'author = :author', 'title like :title'],
3325
        param  => {author => 'Ken', title => '%Perl%'}
3326
    );
updated pod
Yuki Kimoto authored on 2011-06-21
3327
    
3328
    # Array reference 1 (array reference, hash referenc). same as above
3329
    where => [
3330
        ['and', 'author = :author', 'title like :title'],
3331
        {author => 'Ken', title => '%Perl%'}
3332
    ];    
3333
    
3334
    # Array reference 2 (String, hash reference)
3335
    where => [
3336
        'title like :title',
3337
        {title => '%Perl%'}
3338
    ]
3339
    
3340
    # String
3341
    where => 'title is null'
update pod
Yuki Kimoto authored on 2011-03-12
3342

            
updated document
Yuki Kimoto authored on 2011-06-09
3343
Where clause.
3344
    
update pod
Yuki Kimoto authored on 2011-03-12
3345
=back
cleanup
Yuki Kimoto authored on 2011-03-08
3346

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

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

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

            
3353
If you want to set constant value to row data, use scalar reference
3354
as parameter value.
3355

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
3360
=over 4
3361

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

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

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

            
3368
Same as C<execute> method's C<bind_type> option.
3369

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

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

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3376
    id => 4
3377
    id => [4, 5]
- insert, insert_at, update,...
Yuki Kimoto authored on 2011-06-08
3378

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

            
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
3382
    $dbi->update(
updated document
Yuki Kimoto authored on 2011-06-09
3383
        {title => 'Perl', author => 'Ken'}
3384
        parimary_key => ['id1', 'id2'],
3385
        id => [4, 5],
3386
        table => 'book'
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
3387
    );
update pod
Yuki Kimoto authored on 2011-03-13
3388

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

            
updated document
Yuki Kimoto authored on 2011-06-09
3391
    $dbi->update(
3392
        {title => 'Perl', author => 'Ken'}
3393
        where => {id1 => 4, id2 => 5},
3394
        table => 'book'
3395
    );
update pod
Yuki Kimoto authored on 2011-03-13
3396

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

            
3399
    prefix => 'or replace'
3400

            
3401
prefix before table name section
3402

            
3403
    update or replace book
3404

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

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

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

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

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

            
added EXPERIMENTAL execute m...
Yuki Kimoto authored on 2011-08-14
3416
=item C<sqlfilter EXPERIMENTAL>
3417

            
3418
Same as C<execute> method's C<sqlfilter> option.
3419

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

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

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

            
- added EXPERIMENTAL timesta...
Yuki Kimoto authored on 2011-09-02
3426
=item C<timestamp EXPERIMENTAL>
3427

            
3428
    timestamp => 1
3429

            
3430
If this value is set to 1,
3431
automatically updated timestamp column is set based on
3432
C<timestamp> attribute's C<update> value.
3433

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

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

            
3438
=item C<type_rule1_off> EXPERIMENTAL
3439

            
3440
    type_rule1_off => 1
3441

            
3442
Same as C<execute> method's C<type_rule1_off> option.
3443

            
3444
=item C<type_rule2_off> EXPERIMENTAL
3445

            
3446
    type_rule2_off => 1
3447

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

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

            
3452
Same as C<select> method's C<where> option.
3453

            
updated pod
Yuki Kimoto authored on 2011-09-02
3454
=item C<wrap EXPERIMENTAL>
3455

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

            
3458
placeholder wrapped string.
3459

            
3460
If the following statement
3461

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

            
3465
is executed, the following SQL is executed.
3466

            
3467
    update book set price =  ? + 5;
3468

            
updated pod
Yuki Kimoto authored on 2011-06-08
3469
=back
update pod
Yuki Kimoto authored on 2011-03-13
3470

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

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

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

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

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

            
3482
Create update parameter tag.
3483

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

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

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

            
3493
Create a new L<DBIx::Custom::Where> object.
3494

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

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

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

            
fix heading typos
Terrence Brannon authored on 2011-08-17
3502
=head1 ENVIRONMENTAL VARIABLES
added environment variable D...
Yuki Kimoto authored on 2011-04-02
3503

            
3504
=head2 C<DBIX_CUSTOM_DEBUG>
3505

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

            
update pod
Yuki Kimoto authored on 2011-08-10
3509
=head2 C<show_datatype EXPERIMENTAL>
3510

            
3511
    $dbi->show_datatype($table);
3512

            
3513
Show data type of the columns of specified table.
3514

            
3515
    book
3516
    title: 5
3517
    issue_date: 91
3518

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

            
test cleanup
Yuki Kimoto authored on 2011-08-15
3521
=head2 C<show_tables EXPERIMETNAL>
3522

            
3523
    $dbi->show_tables;
3524

            
3525
Show tables.
3526

            
update pod
Yuki Kimoto authored on 2011-08-10
3527
=head2 C<show_typename EXPERIMENTAL>
3528

            
3529
    $dbi->show_typename($table);
3530

            
3531
Show type name of the columns of specified table.
3532

            
3533
    book
3534
    title: varchar
3535
    issue_date: date
3536

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

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

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

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

            
3545
L<DBIx::Custom>
3546

            
3547
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3548
    data_source # will be removed at 2017/1/1
3549
    dbi_options # will be removed at 2017/1/1
3550
    filter_check # will be removed at 2017/1/1
3551
    reserved_word_quote # will be removed at 2017/1/1
3552
    cache_method # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3553
    
3554
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3555
    create_query # will be removed at 2017/1/1
3556
    apply_filter # will be removed at 2017/1/1
3557
    select_at # will be removed at 2017/1/1
3558
    delete_at # will be removed at 2017/1/1
3559
    update_at # will be removed at 2017/1/1
3560
    insert_at # will be removed at 2017/1/1
3561
    register_tag # will be removed at 2017/1/1
3562
    default_bind_filter # will be removed at 2017/1/1
3563
    default_fetch_filter # will be removed at 2017/1/1
3564
    insert_param_tag # will be removed at 2017/1/1
update pod
Yuki Kimoto authored on 2011-08-10
3565
    register_tag # will be removed at 2017/1/1
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3566
    register_tag_processor # will be removed at 2017/1/1
3567
    update_param_tag # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3568
    
3569
    # Options
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3570
    select method relation option # will be removed at 2017/1/1
3571
    select method param option # will be removed at 2017/1/1
3572
    select method column option [COLUMN, as => ALIAS] format
3573
      # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3574
    
3575
    # Others
cleanup
Yuki Kimoto authored on 2011-07-28
3576
    execute("select * from {= title}"); # execute method's
3577
                                        # tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3578
                                        # will be removed at 2017/1/1
3579
    Query caching # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3580

            
3581
L<DBIx::Custom::Model>
3582

            
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3583
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3584
    filter # will be removed at 2017/1/1
3585
    name # will be removed at 2017/1/1
3586
    type # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3587

            
3588
L<DBIx::Custom::Query>
3589
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3590
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3591
    default_filter # will be removed at 2017/1/1
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3592
    table # will be removed at 2017/1/1
3593
    filters # will be removed at 2017/1/1
3594
    
3595
    # Methods
3596
    filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3597

            
3598
L<DBIx::Custom::QueryBuilder>
3599
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3600
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3601
    tags # will be removed at 2017/1/1
3602
    tag_processors # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3603
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3604
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3605
    register_tag # will be removed at 2017/1/1
3606
    register_tag_processor # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3607
    
3608
    # Others
3609
    build_query("select * from {= title}"); # tag parsing functionality
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3610
                                            # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3611

            
3612
L<DBIx::Custom::Result>
3613
    
DBIx::Custom::Query filters ...
Yuki Kimoto authored on 2011-07-30
3614
    # Attribute methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3615
    filter_check # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3616
    
3617
    # Methods
added EXPERIMENTAL each_tabl...
Yuki Kimoto authored on 2011-07-11
3618
    end_filter # will be removed at 2017/1/1
3619
    remove_end_filter # will be removed at 2017/1/1
3620
    remove_filter # will be removed at 2017/1/1
3621
    default_filter # will be removed at 2017/1/1
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3622

            
3623
L<DBIx::Custom::Tag>
3624

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

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

            
3629
If a functionality is DEPRECATED, you can know it by DEPRECATED warnings
3630
except for attribute method.
3631
You can check all DEPRECATED functionalities by document.
3632
DEPRECATED functionality is removed after five years,
3633
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
3634
I extend one year each time he tell me it.
- added EXPERIMENTAL order m...
Yuki Kimoto authored on 2011-06-28
3635

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

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

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

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

            
3644
C<< <kimoto.yuki at gmail.com> >>
3645

            
3646
L<http://github.com/yuki-kimoto/DBIx-Custom>
3647

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
3648
=head1 AUTHOR
3649

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

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

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

            
3656
This program is free software; you can redistribute it and/or modify it
3657
under the same terms as Perl itself.
3658

            
3659
=cut