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

            
cleanup
Yuki Kimoto authored on 2011-04-25
3
our $VERSION = '0.1680';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

            
5
use 5.008001;
cleanup
yuki-kimoto authored on 2009-12-22
6
use strict;
7
use warnings;
8

            
remove run_transaction().
yuki-kimoto authored on 2010-01-30
9
use base 'Object::Simple';
many change
yuki-kimoto authored on 2010-02-11
10

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
cleanup
Yuki Kimoto authored on 2011-04-25
19
use DBIx::Custom::Util qw/_array_to_hash _subname/;
update document
yuki-kimoto authored on 2010-05-27
20
use Encode qw/encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
21

            
added environment variable D...
Yuki Kimoto authored on 2011-04-02
22
use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
23

            
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
24
our @COMMON_ARGS = qw/table query filter type/;
cleanup
Yuki Kimoto authored on 2011-03-21
25

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
86
sub apply_filter {
many changed
Yuki Kimoto authored on 2011-01-23
87
    my ($self, $table, @cinfos) = @_;
88

            
89
    # Initialize filters
cleanup
Yuki Kimoto authored on 2011-01-12
90
    $self->{filter} ||= {};
many changed
Yuki Kimoto authored on 2011-01-23
91
    $self->{filter}{out} ||= {};
92
    $self->{filter}{in} ||= {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
93
    $self->{filter}{end} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-22
94
    
cleanup
Yuki Kimoto authored on 2011-04-02
95
    # Usage
many changed
Yuki Kimoto authored on 2011-01-23
96
    my $usage = "Usage: \$dbi->apply_filter(" .
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
97
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
98
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
cleanup
Yuki Kimoto authored on 2011-04-02
99
    
100
    # Apply filter
many changed
Yuki Kimoto authored on 2011-01-23
101
    for (my $i = 0; $i < @cinfos; $i += 2) {
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
102
        
many changed
Yuki Kimoto authored on 2011-01-23
103
        # Column
104
        my $column = $cinfos[$i];
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
105
        if (ref $column eq 'ARRAY') {
106
            foreach my $c (@$column) {
107
                push @cinfos, $c, $cinfos[$i + 1];
108
            }
109
            next;
110
        }
111
        
cleanup
Yuki Kimoto authored on 2011-04-02
112
        # Filter infomation
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
113
        my $finfo = $cinfos[$i + 1] || {};
cleanup
Yuki Kimoto authored on 2011-04-25
114
        croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
115
          unless  ref $finfo eq 'HASH';
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
116
        foreach my $ftype (keys %$finfo) {
cleanup
Yuki Kimoto authored on 2011-04-25
117
            croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
118
              unless $ftype eq 'in' || $ftype eq 'out' || $ftype eq 'end'; 
many changed
Yuki Kimoto authored on 2011-01-23
119
        }
120
        
cleanup
Yuki Kimoto authored on 2011-04-02
121
        # Set filters
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
122
        foreach my $way (qw/in out end/) {
cleanup
Yuki Kimoto authored on 2011-04-02
123
        
124
            # Filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
125
            my $filter = $finfo->{$way};
cleanup
Yuki Kimoto authored on 2010-12-22
126
            
cleanup
Yuki Kimoto authored on 2011-04-02
127
            # Filter state
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
128
            my $state = !exists $finfo->{$way} ? 'not_exists'
129
                      : !defined $filter        ? 'not_defined'
130
                      : ref $filter eq 'CODE'   ? 'code'
131
                      : 'name';
132
            
cleanup
Yuki Kimoto authored on 2011-04-02
133
            # Filter is not exists
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
134
            next if $state eq 'not_exists';
135
            
cleanup
Yuki Kimoto authored on 2011-04-02
136
            # Check filter name
cleanup
Yuki Kimoto authored on 2011-04-25
137
            croak qq{Filter "$filter" is not registered } . _subname
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
138
              if  $state eq 'name'
139
               && ! exists $self->filters->{$filter};
140
            
cleanup
Yuki Kimoto authored on 2011-04-02
141
            # Set filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
142
            my $f = $state eq 'not_defined' ? undef
143
                  : $state eq 'code'        ? $filter
144
                  : $self->filters->{$filter};
145
            $self->{filter}{$way}{$table}{$column} = $f;
146
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
147
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
148
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
149
    }
150
    
many changed
Yuki Kimoto authored on 2011-01-23
151
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
152
}
153

            
cleanup
Yuki Kimoto authored on 2011-03-21
154
sub column {
155
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
156
    
cleanup
Yuki Kimoto authored on 2011-04-02
157
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
158
    my $q = $self->reserved_word_quote;
159
    
cleanup
Yuki Kimoto authored on 2011-04-02
160
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
161
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
162
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
163
    push @column, "$q$table$q.$q$_$q as $q${table}${q}__$q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
164
    
165
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
166
}
167

            
packaging one directory
yuki-kimoto authored on 2009-11-16
168
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
169
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
170
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
171
    # Connect
172
    $self->dbh;
update document
yuki-kimoto authored on 2010-01-30
173
    
cleanup
Yuki Kimoto authored on 2011-04-02
174
    # Set process ID
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
175
    $self->pid($$);
176
    
packaging one directory
yuki-kimoto authored on 2009-11-16
177
    return $self;
178
}
179

            
cleanup
yuki-kimoto authored on 2010-10-17
180
sub create_query {
181
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
182
    
cleanup
yuki-kimoto authored on 2010-10-17
183
    # Cache
184
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
185
    
cleanup
Yuki Kimoto authored on 2011-04-02
186
    # Query
cleanup
yuki-kimoto authored on 2010-10-17
187
    my $query;
cleanup
Yuki Kimoto authored on 2011-04-02
188
    
189
    # Get cached query
cleanup
yuki-kimoto authored on 2010-10-17
190
    if ($cache) {
191
        
192
        # Get query
193
        my $q = $self->cache_method->($self, $source);
194
        
195
        # Create query
add table tag
Yuki Kimoto authored on 2011-02-09
196
        if ($q) {
197
            $query = DBIx::Custom::Query->new($q);
198
            $query->filters($self->filters);
199
        }
cleanup
yuki-kimoto authored on 2010-10-17
200
    }
201
    
cleanup
Yuki Kimoto authored on 2011-04-02
202
    # Create query
cleanup
yuki-kimoto authored on 2010-10-17
203
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
204

            
cleanup
yuki-kimoto authored on 2010-10-17
205
        # Create query
cleanup
Yuki Kimoto authored on 2011-04-02
206
        my $builder = $self->query_builder;
cleanup
yuki-kimoto authored on 2010-10-17
207
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
208

            
cleanup
Yuki Kimoto authored on 2011-04-02
209
        # Remove reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
210
        if (my $q = $self->reserved_word_quote) {
cleanup
Yuki Kimoto authored on 2011-04-02
211
            $_ =~ s/$q//g for @{$query->columns}
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
212
        }
213

            
cleanup
Yuki Kimoto authored on 2011-04-02
214
        # Save query to cache
215
        $self->cache_method->(
216
            $self, $source,
217
            {
218
                sql     => $query->sql, 
219
                columns => $query->columns,
220
                tables  => $query->tables
221
            }
222
        ) if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
223
    }
224
    
cleanup
yuki-kimoto authored on 2010-10-17
225
    # Prepare statement handle
226
    my $sth;
227
    eval { $sth = $self->dbh->prepare($query->{sql})};
improved error messages
Yuki Kimoto authored on 2011-04-18
228
    
229
    if ($@) {
230
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
231
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
232
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
233
    
cleanup
yuki-kimoto authored on 2010-10-17
234
    # Set statement handle
235
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
236
    
cleanup
Yuki Kimoto authored on 2011-02-09
237
    # Set filters
238
    $query->filters($self->filters);
239
    
cleanup
yuki-kimoto authored on 2010-10-17
240
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
241
}
242

            
update pod
Yuki Kimoto authored on 2011-03-13
243
sub dbh {
244
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
245
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
246
    # Set
247
    if (@_) {
248
        $self->{dbh} = $_[0];
249
        
250
        return $self;
251
    }
252
    
253
    # Get
254
    else {
255
        # From Connction manager
256
        if (my $connector = $self->connector) {
cleanup
Yuki Kimoto authored on 2011-04-25
257
            croak "connector must have dbh() method " . _subname
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
258
              unless ref $connector && $connector->can('dbh');
259
              
260
            return $self->{dbh} = $connector->dbh;
261
        }
262
        
263
        return $self->{dbh} ||= $self->_connect;
update pod
Yuki Kimoto authored on 2011-03-13
264
    }
265
}
266

            
cleanup
Yuki Kimoto authored on 2011-03-21
267
our %DELETE_ARGS
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
268
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all where_param/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
269

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
273
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
274
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
275
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
276
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
277
    }
278
    
279
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
280
    my $table = $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
281
    croak qq{"table" option must be specified. } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
282
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
283
    my $where            = delete $args{where} || {};
284
    my $append           = delete $args{append};
285
    my $allow_delete_all = delete $args{allow_delete_all};
cleanup
Yuki Kimoto authored on 2011-04-02
286
    my $query_return     = delete $args{query};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
287
    my $where_param      = delete $args{where_param} || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
288

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
289
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
290
    my $where_clause = '';
291
    if (ref $where) {
292
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
293
        $where_param = keys %$where_param
294
                     ? $self->merge_param($where_param, $where->param)
295
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
296
        
297
        # String where
298
        $where_clause = $where->to_string;
299
    }
300
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
301
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
302
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
303

            
cleanup
Yuki Kimoto authored on 2011-04-02
304
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
305
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
306
    my $q = $self->reserved_word_quote;
307
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
308
    push @sql, $append if $append;
309
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
310
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
311
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
312
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
313
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
314
    
packaging one directory
yuki-kimoto authored on 2009-11-16
315
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
316
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
317
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
318
        param => $where_param,
cleanup
Yuki Kimoto authored on 2011-03-21
319
        table => $table,
320
        %args
321
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
322
}
323

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
326
our %DELETE_AT_ARGS = (%DELETE_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
327

            
328
sub delete_at {
329
    my ($self, %args) = @_;
330
    
cleanup
Yuki Kimoto authored on 2011-04-02
331
    # Arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
332
    my $primary_keys = delete $args{primary_key};
333
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-04-02
334
    my $where = delete $args{where};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
335
    
cleanup
Yuki Kimoto authored on 2011-04-02
336
    # Check arguments
337
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
338
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
339
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
340
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
341
    
cleanup
Yuki Kimoto authored on 2011-04-02
342
    # Create where parameter
343
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
344
    
cleanup
Yuki Kimoto authored on 2011-04-02
345
    return $self->delete(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
346
}
347

            
added helper method
yuki-kimoto authored on 2010-10-17
348
sub DESTROY { }
349

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
350
sub create_model {
351
    my $self = shift;
352
    
cleanup
Yuki Kimoto authored on 2011-04-02
353
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
354
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
355
    $args->{dbi} = $self;
356
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
357
    my $model_name  = delete $args->{name};
358
    my $model_table = delete $args->{table};
359
    $model_name ||= $model_table;
360
    
cleanup
Yuki Kimoto authored on 2011-04-02
361
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
362
    my $model = $model_class->new($args);
363
    $model->name($model_name) unless $model->name;
364
    $model->table($model_table) unless $model->table;
365
    
366
    # Apply filter
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
367
    my $filter = ref $model->filter eq 'HASH'
368
               ? [%{$model->filter}]
369
               : $model->filter;
370
    $self->apply_filter($model->table, @$filter);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
371
    
cleanup
Yuki Kimoto authored on 2011-04-02
372
    # Associate table with model
cleanup
Yuki Kimoto authored on 2011-04-25
373
    croak "Table name is duplicated " . _subname
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
374
      if exists $self->{_model_from}->{$model->table};
375
    $self->{_model_from}->{$model->table} = $model->name;
376

            
377
    # Table alias
378
    $self->{_table_alias} ||= {};
379
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
380
    
381
    # Set model
382
    $self->model($model->name, $model);
383
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
384
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
385
}
386

            
387
sub each_column {
388
    my ($self, $cb) = @_;
389
    
390
    # Iterate all tables
391
    my $sth_tables = $self->dbh->table_info;
392
    while (my $table_info = $sth_tables->fetchrow_hashref) {
393
        
394
        # Table
395
        my $table = $table_info->{TABLE_NAME};
396
        
397
        # Iterate all columns
398
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
399
        while (my $column_info = $sth_columns->fetchrow_hashref) {
400
            my $column = $column_info->{COLUMN_NAME};
401
            $self->$cb($table, $column, $column_info);
402
        }
403
    }
404
}
405

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

            
408
sub execute {
cleanup
yuki-kimoto authored on 2010-10-17
409
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
410
    
cleanup
Yuki Kimoto authored on 2011-04-02
411
    # Arguments
cleanup
Yuki Kimoto authored on 2011-04-02
412
    my $param  = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
413
    my $tables = delete $args{table} || [];
414
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
415
    my $filter = delete $args{filter};
cleanup
Yuki Kimoto authored on 2011-04-25
416
    $filter = _array_to_hash($filter);
cleanup
Yuki Kimoto authored on 2011-04-02
417
    my $type = delete $args{type};
cleanup
Yuki Kimoto authored on 2011-04-25
418
    $type = _array_to_hash($type);
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
419
    
cleanup
Yuki Kimoto authored on 2011-03-09
420
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
421
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
422
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
423
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
424
    }
425
    
cleanup
Yuki Kimoto authored on 2011-04-02
426
    # Create query
427
    $query = $self->create_query($query) unless ref $query;
cleanup
Yuki Kimoto authored on 2011-04-02
428
    $filter ||= $query->filter;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
429
    
cleanup
Yuki Kimoto authored on 2011-04-02
430
    # Tables
431
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
432
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
433
    $tables = $self->_remove_duplicate_table($tables, $main_table);
434
    if (my $q = $self->reserved_word_quote) {
435
        $_ =~ s/$q//g for @$tables;
436
    }
cleanup
Yuki Kimoto authored on 2011-04-02
437
    
438
    # Table alias
cleanup
Yuki Kimoto authored on 2011-04-02
439
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
440
        
cleanup
Yuki Kimoto authored on 2011-04-02
441
        # No need
442
        next unless my $alias = $self->{_table_alias}->{$table};
443
        $self->{filter} ||= {};
444
        next if $self->{filter}{out}{$table};
445
        
446
        # Filter
447
        $self->{filter}{out} ||= {};
448
        $self->{filter}{in}  ||= {};
449
        $self->{filter}{end} ||= {};
450
        
451
        # Create alias filter
452
        foreach my $type (qw/out in end/) {
453
            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};
454
            foreach my $filter_name (@filter_names) {
455
                my $filter_name_alias = $filter_name;
456
                $filter_name_alias =~ s/^$alias\./$table\./;
457
                $filter_name_alias =~ s/^${alias}__/${table}__/; 
458
                $self->{filter}{$type}{$table}{$filter_name_alias}
459
                  = $self->{filter}{$type}{$alias}{$filter_name}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
460
            }
461
        }
462
    }
cleanup
Yuki Kimoto authored on 2011-04-02
463
    
464
    # Applied filter
465
    my $applied_filter = {};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
466
    foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
467
        $applied_filter = {
468
            %$applied_filter,
cleanup
Yuki Kimoto authored on 2011-01-12
469
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
470
        }
471
    }
cleanup
Yuki Kimoto authored on 2011-04-02
472
    $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
473
    
cleanup
Yuki Kimoto authored on 2011-04-02
474
    # Replace filter name to code
475
    foreach my $column (keys %$filter) {
476
        my $name = $filter->{$column};
477
        if (!defined $name) {
478
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
479
        }
cleanup
Yuki Kimoto authored on 2011-04-02
480
        elsif (ref $name ne 'CODE') {
cleanup
Yuki Kimoto authored on 2011-04-25
481
          croak qq{Filter "$name" is not registered" } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
482
            unless exists $self->filters->{$name};
483
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
484
        }
485
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
486
    
cleanup
Yuki Kimoto authored on 2011-04-02
487
    # Create bind values
488
    my $bind = $self->_create_bind_values(
489
        $param,
490
        $query->columns,
491
        $filter,
492
        $type
493
    );
cleanup
yuki-kimoto authored on 2010-10-17
494
    
495
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
496
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
497
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
498
    eval {
499
        for (my $i = 0; $i < @$bind; $i++) {
cleanup
Yuki Kimoto authored on 2011-04-02
500
            my $type = $bind->[$i]->{type};
501
            $sth->bind_param($i + 1, $bind->[$i]->{value}, $type ? $type : ());
cleanup
Yuki Kimoto authored on 2011-03-21
502
        }
503
        $affected = $sth->execute;
504
    };
improved error messages
Yuki Kimoto authored on 2011-04-18
505
    
506
    if ($@) {
507
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
508
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
509
    }
cleanup
yuki-kimoto authored on 2010-10-17
510
    
added environment variable D...
Yuki Kimoto authored on 2011-04-02
511
    # Output SQL for debug
512
    warn $query->sql . "\n" if DEBUG;
513
    
cleanup
Yuki Kimoto authored on 2011-04-02
514
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
515
    if ($sth->{NUM_OF_FIELDS}) {
516
        
cleanup
Yuki Kimoto authored on 2011-04-02
517
        # Filter
518
        my $filter = {};
519
        $filter->{in}  = {};
520
        $filter->{end} = {};
cleanup
Yuki Kimoto authored on 2011-01-12
521
        foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
522
            foreach my $way (qw/in end/) {
523
                $filter->{$way} = {
524
                    %{$filter->{$way}},
525
                    %{$self->{filter}{$way}{$table} || {}}
526
                };
527
            }
cleanup
Yuki Kimoto authored on 2011-01-12
528
        }
529
        
530
        # Result
531
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
532
            sth            => $sth,
533
            filters        => $self->filters,
534
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
535
            default_filter => $self->{default_in_filter},
cleanup
Yuki Kimoto authored on 2011-04-02
536
            filter         => $filter->{in} || {},
537
            end_filter     => $filter->{end} || {}
cleanup
yuki-kimoto authored on 2010-10-17
538
        );
539

            
540
        return $result;
541
    }
cleanup
Yuki Kimoto authored on 2011-04-02
542
    
543
    # Not select statement
544
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
545
}
546

            
cleanup
Yuki Kimoto authored on 2011-03-21
547
our %INSERT_ARGS = map { $_ => 1 } @COMMON_ARGS, qw/param append/;
update pod
Yuki Kimoto authored on 2011-03-13
548

            
cleanup
yuki-kimoto authored on 2010-10-17
549
sub insert {
550
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
551
    
cleanup
yuki-kimoto authored on 2010-10-17
552
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
553
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
554
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
555
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
556
    my $param  = delete $args{param} || {};
557
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
558
    my $query_return  = delete $args{query};
559

            
560
    # Check arguments
561
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
562
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
563
          unless $INSERT_ARGS{$name};
564
    }
565

            
566
    # Reserved word quote
567
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
568
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
569
    # Columns
570
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
571
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
572
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
573
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
574
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
575
          $column = "$q$column$q";
576
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
577
        push @columns, $column;
578
    }
cleanup
yuki-kimoto authored on 2010-10-17
579
    
cleanup
Yuki Kimoto authored on 2011-04-02
580
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
581
    my @sql;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
582
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
583
    push @sql, $append if $append;
584
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
585
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
586
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
587
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
588
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
589
    
packaging one directory
yuki-kimoto authored on 2009-11-16
590
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
591
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
592
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
593
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
594
        table => $table,
595
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
596
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
597
}
598

            
cleanup
Yuki Kimoto authored on 2011-03-21
599
our %INSERT_AT_ARGS = (%INSERT_ARGS, where => 1, primary_key => 1);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
600

            
601
sub insert_at {
602
    my ($self, %args) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
603

            
604
    # Arguments
605
    my $primary_keys = delete $args{primary_key};
606
    $primary_keys = [$primary_keys] unless ref $primary_keys;
607
    my $where = delete $args{where};
608
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
609
    
cleanup
Yuki Kimoto authored on 2011-04-02
610
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
611
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
612
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
613
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
614
    }
615
    
cleanup
Yuki Kimoto authored on 2011-04-02
616
    # Create where parameter
617
    my $where_param = $self->_create_where_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-04-02
618
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
619
    
620
    return $self->insert(param => $param, %args);
621
}
622

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
623
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
624
    my ($self, $param) = @_;
625
    
cleanup
Yuki Kimoto authored on 2011-04-02
626
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
627
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
628
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
629
    my @columns;
630
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
631
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
632
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
633
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
634
        $column = "$q$column$q";
635
        $column =~ s/\./$q.$q/;
636
        push @columns, $column;
637
        push @placeholders, "{? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
638
    }
639
    
cleanup
Yuki Kimoto authored on 2011-04-02
640
    return '(' . join(', ', @columns) . ') ' . 'values ' .
641
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
642
}
643

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

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
709
sub merge_param {
710
    my ($self, @params) = @_;
711
    
cleanup
Yuki Kimoto authored on 2011-04-02
712
    # Merge parameters
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
713
    my $param = {};
714
    foreach my $p (@params) {
715
        foreach my $column (keys %$p) {
716
            if (exists $param->{$column}) {
717
                $param->{$column} = [$param->{$column}]
718
                  unless ref $param->{$column} eq 'ARRAY';
719
                push @{$param->{$column}}, $p->{$column};
720
            }
721
            else {
722
                $param->{$column} = $p->{$column};
723
            }
724
        }
725
    }
726
    
727
    return $param;
728
}
729

            
cleanup
Yuki Kimoto authored on 2011-03-21
730
sub method {
731
    my $self = shift;
732
    
cleanup
Yuki Kimoto authored on 2011-04-02
733
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
734
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
735
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
736
    
737
    return $self;
738
}
739

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
769
sub new {
770
    my $self = shift->SUPER::new(@_);
771
    
cleanup
Yuki Kimoto authored on 2011-04-02
772
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
773
    my @attrs = keys %$self;
774
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
775
        croak qq{"$attr" is wrong name } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
776
          unless $self->can($attr);
777
    }
cleanup
Yuki Kimoto authored on 2011-04-02
778
    
779
    # Register tag
cleanup
Yuki Kimoto authored on 2011-01-25
780
    $self->register_tag(
781
        '?'     => \&DBIx::Custom::Tag::placeholder,
782
        '='     => \&DBIx::Custom::Tag::equal,
783
        '<>'    => \&DBIx::Custom::Tag::not_equal,
784
        '>'     => \&DBIx::Custom::Tag::greater_than,
785
        '<'     => \&DBIx::Custom::Tag::lower_than,
786
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
787
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
788
        'like'  => \&DBIx::Custom::Tag::like,
789
        'in'    => \&DBIx::Custom::Tag::in,
790
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
791
        'update_param' => \&DBIx::Custom::Tag::update_param
792
    );
added dbi_options attribute
kimoto authored on 2010-12-20
793
    
794
    return $self;
795
}
796

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

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

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
809
sub register_tag { shift->query_builder->register_tag(@_) }
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
810

            
cleanup
Yuki Kimoto authored on 2011-03-21
811
our %SELECT_ARGS
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
812
  = map { $_ => 1 } @COMMON_ARGS,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
813
                    qw/column where append relation join param where_param wrap/;
refactoring select
yuki-kimoto authored on 2010-04-28
814

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
818
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
819
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
820
    my $tables = ref $table eq 'ARRAY' ? $table
821
               : defined $table ? [$table]
822
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
823
    my $columns   = delete $args{column};
824
    my $where     = delete $args{where} || {};
825
    my $append    = delete $args{append};
826
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
827
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
828
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
829
    my $relation = delete $args{relation};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
830
    my $param = delete $args{param} || {}; # DEPRECATED!
831
    warn "DEPRECATED select() param option. this is renamed to where_param"
832
      if keys %$param;
833
    my $where_param = delete $args{where_param} || $param || {};
cleanup
Yuki Kimoto authored on 2011-04-02
834
    my $query_return = $args{query};
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
835
    my $wrap = delete $args{wrap};
cleanup
Yuki Kimoto authored on 2011-04-02
836

            
837
    # Check arguments
838
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
839
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
840
          unless $SELECT_ARGS{$name};
841
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
842
    
cleanup
Yuki Kimoto authored on 2011-03-09
843
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
844
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
845
    
cleanup
Yuki Kimoto authored on 2011-04-02
846
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
847
    my @sql;
848
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
849
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
850
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
851
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
852
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
853
        foreach my $column (@$columns) {
cleanup
Yuki Kimoto authored on 2011-04-02
854
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
855
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
856
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
857
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
858
    }
859
    else { push @sql, '*' }
860
    
861
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
862
    push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-04-02
863
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-30
864
    if ($relation) {
865
        my $found = {};
866
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
867
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
868
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
869
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
870
    }
cleanup
Yuki Kimoto authored on 2011-03-30
871
    else {
872
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
873
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
874
    }
875
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
876
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
877
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
878

            
cleanup
Yuki Kimoto authored on 2011-04-02
879
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
880
    unshift @$tables,
881
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
882
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
883
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
884
    my $where_clause = '';
cleanup
Yuki Kimoto authored on 2011-04-25
885
    if (ref $where) {
886
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
887
        $where_param = keys %$where_param
888
                     ? $self->merge_param($where_param, $where->param)
889
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
890
        
891
        # String where
892
        $where_clause = $where->to_string;
893
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
894
    elsif ($where) { $where_clause = "where $where" }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
895
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
896
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
897
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
898
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
899
    # Push join
900
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
901
    
cleanup
Yuki Kimoto authored on 2011-03-09
902
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
903
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
904
    
cleanup
Yuki Kimoto authored on 2011-03-08
905
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
906
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
907
    
cleanup
Yuki Kimoto authored on 2011-04-02
908
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
909
    push @sql, $append if $append;
910
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
911
    # Wrap
912
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
913
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
914
          unless ref $wrap eq 'ARRAY';
915
        unshift @sql, $wrap->[0];
916
        push @sql, $wrap->[1];
917
    }
918
    
cleanup
Yuki Kimoto authored on 2011-01-27
919
    # SQL
920
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
921
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
922
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
923
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
924
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
925
    
packaging one directory
yuki-kimoto authored on 2009-11-16
926
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
927
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
928
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
929
        param => $where_param, 
cleanup
Yuki Kimoto authored on 2011-03-21
930
        table => $tables,
931
        %args
932
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
933
    
934
    return $result;
935
}
936

            
cleanup
Yuki Kimoto authored on 2011-03-21
937
our %SELECT_AT_ARGS = (%SELECT_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
938

            
939
sub select_at {
940
    my ($self, %args) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
941

            
942
    # Arguments
943
    my $primary_keys = delete $args{primary_key};
944
    $primary_keys = [$primary_keys] unless ref $primary_keys;
945
    my $where = delete $args{where};
946
    my $param = delete $args{param};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
947
    
cleanup
Yuki Kimoto authored on 2011-04-02
948
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
949
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
950
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
951
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
952
    }
953
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
954
    # Table
cleanup
Yuki Kimoto authored on 2011-04-25
955
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
956
      unless $args{table};
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
957
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
958
    
cleanup
Yuki Kimoto authored on 2011-04-02
959
    # Create where parameter
960
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
961
    
cleanup
Yuki Kimoto authored on 2011-04-02
962
    return $self->select(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
963
}
964

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
965
sub setup_model {
966
    my $self = shift;
967
    
cleanup
Yuki Kimoto authored on 2011-04-02
968
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
969
    $self->each_column(
970
        sub {
971
            my ($self, $table, $column, $column_info) = @_;
972
            if (my $model = $self->models->{$table}) {
973
                push @{$model->columns}, $column;
974
            }
975
        }
976
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
977
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
978
}
979

            
cleanup
Yuki Kimoto authored on 2011-03-21
980
our %UPDATE_ARGS
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
981
  = map { $_ => 1 } @COMMON_ARGS, qw/param where append allow_update_all where_param/;
cleanup
yuki-kimoto authored on 2010-10-17
982

            
983
sub update {
984
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
985

            
cleanup
yuki-kimoto authored on 2010-10-17
986
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
987
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
988
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
989
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
990
    my $param            = delete $args{param} || {};
991
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
992
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
993
    my $append           = delete $args{append} || '';
994
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
995
    
cleanup
Yuki Kimoto authored on 2011-04-02
996
    # Check argument names
997
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
998
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
999
          unless $UPDATE_ARGS{$name};
1000
    }
1001
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1002
    # Columns
1003
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1004
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
1005
    my $q = $self->reserved_word_quote;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1006
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
1007
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1008
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1009
          $column = "$q$column$q";
1010
          $column =~ s/\./$q.$q/;
1011
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1012
    }
1013
        
cleanup
yuki-kimoto authored on 2010-10-17
1014
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1015
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1016

            
1017
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1018
    my $where_clause = '';
1019
    if (ref $where) {
1020
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1021
        $where_param = keys %$where_param
1022
                     ? $self->merge_param($where_param, $where->param)
1023
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1024
        
1025
        # String where
1026
        $where_clause = $where->to_string;
1027
    }
1028
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1029
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1030
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1031
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1032
    # Merge param
1033
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1034
    
cleanup
Yuki Kimoto authored on 2011-04-02
1035
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1036
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
1037
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1038
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1039
    
cleanup
Yuki Kimoto authored on 2011-01-27
1040
    # SQL
1041
    my $sql = join(' ', @sql);
1042
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1043
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1044
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1045
    return $query if $args{query};
1046
    
cleanup
yuki-kimoto authored on 2010-10-17
1047
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1048
    my $ret_val = $self->execute(
1049
        $query,
1050
        param  => $param, 
1051
        table => $table,
1052
        %args
1053
    );
cleanup
yuki-kimoto authored on 2010-10-17
1054
    
1055
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1056
}
1057

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
1060
our %UPDATE_AT_ARGS = (%UPDATE_ARGS, where => 1, primary_key => 1);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1061

            
1062
sub update_at {
1063
    my ($self, %args) = @_;
1064
    
cleanup
Yuki Kimoto authored on 2011-04-02
1065
    # Arguments
1066
    my $primary_keys = delete $args{primary_key};
1067
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1068
    my $where = delete $args{where};
1069
    
1070

            
1071
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1072
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1073
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
1074
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1075
    }
1076
    
cleanup
Yuki Kimoto authored on 2011-04-02
1077
    # Create where parameter
1078
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1079
    
cleanup
Yuki Kimoto authored on 2011-04-02
1080
    return $self->update(where => $where_param, %args);
1081
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1082

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1083
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1084
    my ($self, $param, $opt) = @_;
1085
    
cleanup
Yuki Kimoto authored on 2011-04-02
1086
    # Create update parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1087
    my @params;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1088
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1089
    my $q = $self->reserved_word_quote;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1090
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
1091
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1092
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
1093
        my $column = "$q$column$q";
1094
        $column =~ s/\./$q.$q/;
1095
        push @params, "$column = {? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1096
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1097
    my $tag;
1098
    $tag .= 'set ' unless $opt->{no_set};
1099
    $tag .= join(', ', @params);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1100
    
cleanup
Yuki Kimoto authored on 2011-04-02
1101
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1102
}
1103

            
cleanup
Yuki Kimoto authored on 2011-01-25
1104
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1105
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1106
    
1107
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1108
    return DBIx::Custom::Where->new(
1109
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1110
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1111
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1112
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1113
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1114
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1115

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

            
improved error messages
Yuki Kimoto authored on 2011-04-18
1161
sub _create_where_param {
1162
    my ($self, $where, $primary_keys) = @_;
1163
    
1164
    # Create where parameter
1165
    my $where_param = {};
1166
    if ($where) {
1167
        $where = [$where] unless ref $where;
1168
        croak qq{"where" must be constant value or array reference}
1169
            . " (" . (caller 1)[3] . ")"
1170
          unless !ref $where || ref $where eq 'ARRAY';
1171
        
1172
        croak qq{"where" must contain values same count as primary key}
1173
            . " (" . (caller 1)[3] . ")"
1174
          unless @$primary_keys eq @$where;
1175
        
1176
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1177
           $where_param->{$primary_keys->[$i]} = $where->[$i];
1178
        }
1179
    }
1180
    
1181
    return $where_param;
1182
}
1183

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1184
sub _connect {
1185
    my $self = shift;
1186
    
1187
    # Attributes
1188
    my $data_source = $self->data_source;
cleanup
Yuki Kimoto authored on 2011-04-25
1189
    croak qq{"data_source" must be specified } . _subname
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1190
      unless $data_source;
1191
    my $user        = $self->user;
1192
    my $password    = $self->password;
1193
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1194
    
1195
    # Connect
1196
    my $dbh = eval {DBI->connect(
1197
        $data_source,
1198
        $user,
1199
        $password,
1200
        {
1201
            %{$self->default_dbi_option},
1202
            %$dbi_option
1203
        }
1204
    )};
1205
    
1206
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1207
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1208
    
1209
    return $dbh;
1210
}
1211

            
cleanup
yuki-kimoto authored on 2010-10-17
1212
sub _croak {
1213
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1214
    
1215
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1216
    $append ||= "";
1217
    
1218
    # Verbose
1219
    if ($Carp::Verbose) { croak $error }
1220
    
1221
    # Not verbose
1222
    else {
1223
        
1224
        # Remove line and module infromation
1225
        my $at_pos = rindex($error, ' at ');
1226
        $error = substr($error, 0, $at_pos);
1227
        $error =~ s/\s+$//;
1228
        croak "$error$append";
1229
    }
1230
}
1231

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1232
sub _need_tables {
1233
    my ($self, $tree, $need_tables, $tables) = @_;
1234
    
cleanup
Yuki Kimoto authored on 2011-04-02
1235
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1236
    foreach my $table (@$tables) {
1237
        if ($tree->{$table}) {
1238
            $need_tables->{$table} = 1;
1239
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1240
        }
1241
    }
1242
}
1243

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1285
sub _remove_duplicate_table {
1286
    my ($self, $tables, $main_table) = @_;
1287
    
1288
    # Remove duplicate table
1289
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1290
    delete $tables{$main_table} if $main_table;
1291
    
1292
    return [keys %tables, $main_table ? $main_table : ()];
1293
}
1294

            
cleanup
Yuki Kimoto authored on 2011-04-02
1295
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1296
    my ($self, $source) = @_;
1297
    
cleanup
Yuki Kimoto authored on 2011-04-02
1298
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1299
    my $tables = [];
1300
    my $safety_character = $self->safety_character;
1301
    my $q = $self->reserved_word_quote;
1302
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1303
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1304
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1305
    while ($source =~ /$table_re/g) {
1306
        push @$tables, $1;
1307
    }
1308
    
1309
    return $tables;
1310
}
1311

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1354
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1355
__PACKAGE__->attr(
1356
    dbi_options => sub { {} },
1357
    filter_check  => 1
1358
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1359

            
cleanup
Yuki Kimoto authored on 2011-01-25
1360
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1361
sub default_bind_filter {
1362
    my $self = shift;
1363
    
1364
    if (@_) {
1365
        my $fname = $_[0];
1366
        
1367
        if (@_ && !$fname) {
1368
            $self->{default_out_filter} = undef;
1369
        }
1370
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1371
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1372
              unless exists $self->filters->{$fname};
1373
        
1374
            $self->{default_out_filter} = $self->filters->{$fname};
1375
        }
1376
        return $self;
1377
    }
1378
    
1379
    return $self->{default_out_filter};
1380
}
1381

            
cleanup
Yuki Kimoto authored on 2011-01-25
1382
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1383
sub default_fetch_filter {
1384
    my $self = shift;
1385
    
1386
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1387
        my $fname = $_[0];
1388

            
cleanup
Yuki Kimoto authored on 2011-01-12
1389
        if (@_ && !$fname) {
1390
            $self->{default_in_filter} = undef;
1391
        }
1392
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1393
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1394
              unless exists $self->filters->{$fname};
1395
        
1396
            $self->{default_in_filter} = $self->filters->{$fname};
1397
        }
1398
        
1399
        return $self;
1400
    }
1401
    
many changed
Yuki Kimoto authored on 2011-01-23
1402
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1403
}
1404

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1405
# DEPRECATED!
1406
sub insert_param {
1407
    warn "insert_param is renamed to insert_param_tag."
1408
       . " insert_param is DEPRECATED!";
1409
    return shift->insert_param_tag(@_);
1410
}
1411

            
cleanup
Yuki Kimoto authored on 2011-01-25
1412
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1413
sub register_tag_processor {
1414
    return shift->query_builder->register_tag_processor(@_);
1415
}
1416

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1417
# DEPRECATED!
1418
sub update_param {
1419
    warn "update_param is renamed to update_param_tag."
1420
       . " update_param is DEPRECATED!";
1421
    return shift->update_param_tag(@_);
1422
}
cleanup
Yuki Kimoto authored on 2011-03-08
1423
# DEPRECATED!
1424
sub _push_relation {
1425
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1426
    
1427
    if (keys %{$relation || {}}) {
1428
        push @$sql, $need_where ? 'where' : 'and';
1429
        foreach my $rcolumn (keys %$relation) {
1430
            my $table1 = (split (/\./, $rcolumn))[0];
1431
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1432
            push @$tables, ($table1, $table2);
1433
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1434
        }
1435
    }
1436
    pop @$sql if $sql->[-1] eq 'and';    
1437
}
1438

            
1439
# DEPRECATED!
1440
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1441
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1442
    
1443
    if (keys %{$relation || {}}) {
1444
        foreach my $rcolumn (keys %$relation) {
1445
            my $table1 = (split (/\./, $rcolumn))[0];
1446
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1447
            my $table1_exists;
1448
            my $table2_exists;
1449
            foreach my $table (@$tables) {
1450
                $table1_exists = 1 if $table eq $table1;
1451
                $table2_exists = 1 if $table eq $table2;
1452
            }
1453
            unshift @$tables, $table1 unless $table1_exists;
1454
            unshift @$tables, $table2 unless $table2_exists;
1455
        }
1456
    }
1457
}
1458

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1461
=head1 NAME
1462

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

            
1465
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1466

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1467
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1468
    
1469
    # Connect
1470
    my $dbi = DBIx::Custom->connect(
1471
        data_source => "dbi:mysql:database=dbname",
1472
        user => 'ken',
1473
        password => '!LFKD%$&',
1474
        dbi_option => {mysql_enable_utf8 => 1}
1475
    );
cleanup
yuki-kimoto authored on 2010-08-05
1476

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1477
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1478
    $dbi->insert(
1479
        table  => 'book',
1480
        param  => {title => 'Perl', author => 'Ken'}
1481
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1482
    
1483
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1484
    $dbi->update(
1485
        table  => 'book', 
1486
        param  => {title => 'Perl', author => 'Ken'}, 
1487
        where  => {id => 5},
1488
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1489
    
1490
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1491
    $dbi->delete(
1492
        table  => 'book',
1493
        where  => {author => 'Ken'},
1494
    );
cleanup
yuki-kimoto authored on 2010-08-05
1495

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1502
    # Select, more complex
1503
    my $result = $dbi->select(
1504
        table  => 'book',
1505
        column => [
1506
            'book.author as book__author',
1507
            'company.name as company__name'
1508
        ],
1509
        where  => {'book.author' => 'Ken'},
1510
        join => ['left outer join company on book.company_id = company.id'],
1511
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1512
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1513
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1514
    # Fetch
1515
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1516
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1517
    }
1518
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1519
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1520
    while (my $row = $result->fetch_hash) {
1521
        
1522
    }
1523
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1524
    # Execute SQL with parameter.
1525
    $dbi->execute(
1526
        "select id from book where {= author} and {like title}",
1527
        param  => {author => 'ken', title => '%Perl%'}
1528
    );
1529
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1530
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1531

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

            
1534
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1535

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1540
There are many basic methods to execute various queries.
1541
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1542
C<delete_all()>, C<select()>,
1543
C<insert_at()>, C<update_at()>, 
1544
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1545

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1546
=item *
1547

            
1548
Filter when data is send or receive.
1549

            
1550
=item *
1551

            
1552
Data filtering system
1553

            
1554
=item *
1555

            
1556
Model support.
1557

            
1558
=item *
1559

            
1560
Generate where clause dinamically.
1561

            
1562
=item *
1563

            
1564
Generate join clause dinamically.
1565

            
1566
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1567

            
1568
=head1 GUIDE
1569

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

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

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

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

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

            
1580
    my $connector = $dbi->connector;
1581
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1582

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

            
1586
This is L<DBIx::Connector> example. Please pass
1587
C<default_dbi_option> to L<DBIx::Connector>.
1588

            
1589
    my $connector = DBIx::Connector->new(
1590
        "dbi:mysql:database=$DATABASE",
1591
        $USER,
1592
        $PASSWORD,
1593
        DBIx::Custom->new->default_dbi_option
1594
    );
1595
    
1596
    my $dbi = DBIx::Custom->new(connector => $connector);
1597

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

            
cleanup
yuki-kimoto authored on 2010-08-03
1600
    my $data_source = $dbi->data_source;
cleanup
yuki-kimoto authored on 2010-08-05
1601
    $dbi            = $dbi->data_source("DBI:mysql:database=dbname");
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1602

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1603
Data source, used when C<connect()> is executed.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1604

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

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

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

            
1613
=head2 C<default_dbi_option>
1614

            
1615
    my $default_dbi_option = $dbi->default_dbi_option;
1616
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1617

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1621
    {
1622
        RaiseError => 1,
1623
        PrintError => 0,
1624
        AutoCommit => 1,
1625
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1626

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

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

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

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

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

            
1639
    my $models = $dbi->models;
1640
    $dbi       = $dbi->models(\%models);
1641

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1644
=head2 C<password>
1645

            
1646
    my $password = $dbi->password;
1647
    $dbi         = $dbi->password('lkj&le`@s');
1648

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

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

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

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

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

            
1660
     my reserved_word_quote = $dbi->reserved_word_quote;
1661
     $dbi                   = $dbi->reserved_word_quote('"');
1662

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1682
    my $user = $dbi->user;
1683
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1684

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1695
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1696
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1697
        'issue_date' => {
1698
            out => 'tp_to_date',
1699
            in  => 'date_to_tp',
1700
            end => 'tp_to_displaydate'
1701
        },
1702
        'write_date' => {
1703
            out => 'tp_to_date',
1704
            in  => 'date_to_tp',
1705
            end => 'tp_to_displaydate'
1706
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1707
    );
1708

            
update pod
Yuki Kimoto authored on 2011-03-13
1709
Apply filter to columns.
1710
C<out> filter is executed before data is send to database.
1711
C<in> filter is executed after a row is fetch.
1712
C<end> filter is execute after C<in> filter is executed.
1713

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1716
       PETTERN         EXAMPLE
1717
    1. Column        : author
1718
    2. Table.Column  : book.author
1719
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1720

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

            
1724
You can set multiple filters at once.
1725

            
1726
    $dbi->apply_filter(
1727
        'book',
1728
        [qw/issue_date write_date/] => {
1729
            out => 'tp_to_date',
1730
            in  => 'date_to_tp',
1731
            end => 'tp_to_displaydate'
1732
        }
1733
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1734

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1737
    my $dbi = DBIx::Custom->connect(
1738
        data_source => "dbi:mysql:database=dbname",
1739
        user => 'ken',
1740
        password => '!LFKD%$&',
1741
        dbi_option => {mysql_enable_utf8 => 1}
1742
    );
1743

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1752
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1753
        table => 'book',
1754
        primary_key => 'id',
1755
        join => [
1756
            'inner join company on book.comparny_id = company.id'
1757
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1758
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1759
            publish_date => {
1760
                out => 'tp_to_date',
1761
                in => 'date_to_tp',
1762
                end => 'tp_to_displaydate'
1763
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1764
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1765
    );
1766

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

            
1770
   $dbi->model('book')->select(...);
1771

            
cleanup
yuki-kimoto authored on 2010-10-17
1772
=head2 C<create_query>
1773
    
1774
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1775
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1776
    );
update document
yuki-kimoto authored on 2009-11-19
1777

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

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

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

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

            
1788
    my $dbh = $dbi->dbh;
1789

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

            
1793
=head2 C<each_column>
1794

            
1795
    $dbi->each_column(
1796
        sub {
1797
            my ($dbi, $table, $column, $column_info) = @_;
1798
            
1799
            my $type = $column_info->{TYPE_NAME};
1800
            
1801
            if ($type eq 'DATE') {
1802
                # ...
1803
            }
1804
        }
1805
    );
1806

            
1807
Iterate all column informations of all table from database.
1808
Argument is callback when one column is found.
1809
Callback receive four arguments, dbi object, table name,
1810
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1811

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1814
    my $result = $dbi->execute(
1815
        "select * from book where {= title} and {like author}",
1816
        param => {title => 'Perl', author => '%Ken%'}
1817
    );
1818

            
1819
Execute SQL, containing tags.
1820
Return value is L<DBIx::Custom::Result> in select statement, or
1821
the count of affected rows in insert, update, delete statement.
1822

            
1823
Tag is turned into the statement containing place holder
1824
before SQL is executed.
1825

            
1826
    select * from where title = ? and author like ?;
1827

            
1828
See also L<Tags/Tags>.
1829

            
1830
The following opitons are currently available.
1831

            
1832
=over 4
1833

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

            
1836
Table names for filtering.
1837

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

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

            
1843

            
1844

            
1845

            
1846

            
1847

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

            
1850
Filter, executed before data is send to database. This is array reference.
1851
Filter value is code reference or
1852
filter name registerd by C<register_filter()>.
1853

            
1854
    # Basic
1855
    $dbi->execute(
1856
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1857
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1858
            title  => sub { uc $_[0] }
1859
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1860
        }
update pod
Yuki Kimoto authored on 2011-03-13
1861
    );
1862
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1863
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1864
    $dbi->execute(
1865
        $sql,
1866
        filter => [
1867
            [qw/title author/]  => sub { uc $_[0] }
1868
        ]
1869
    );
1870
    
1871
    # Filter name
1872
    $dbi->execute(
1873
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1874
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1875
            title  => 'upper_case',
1876
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1877
        }
update pod
Yuki Kimoto authored on 2011-03-13
1878
    );
1879

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

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

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

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

            
1888
Delete statement.
1889

            
1890
The following opitons are currently available.
1891

            
update pod
Yuki Kimoto authored on 2011-03-13
1892
=over 4
1893

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

            
1896
Table name.
1897

            
1898
    $dbi->delete(table => 'book');
1899

            
1900
=item C<where>
1901

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1902
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1903
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1904
    
1905
    # Hash reference
1906
    $dbi->delete(where => {title => 'Perl'});
1907
    
1908
    # DBIx::Custom::Where object
1909
    my $where = $dbi->where(
1910
        clause => ['and', '{= author}', '{like title}'],
1911
        param  => {author => 'Ken', title => '%Perl%'}
1912
    );
1913
    $dbi->delete(where => $where);
1914

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1915
    # Array refrendce (where clause and parameter)
1916
    $dbi->delete(where =>
1917
        [
1918
            ['and', '{= author}', '{like title}'],
1919
            {author => 'Ken', title => '%Perl%'}
1920
        ]
1921
    );
1922
    
update pod
Yuki Kimoto authored on 2011-03-13
1923
=item C<append>
1924

            
1925
Append statement to last of SQL. This is string.
1926

            
1927
    $dbi->delete(append => 'order by title');
1928

            
1929
=item C<filter>
1930

            
1931
Filter, executed before data is send to database. This is array reference.
1932
Filter value is code reference or
1933
filter name registerd by C<register_filter()>.
1934

            
1935
    # Basic
1936
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1937
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1938
            title  => sub { uc $_[0] }
1939
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1940
        }
update pod
Yuki Kimoto authored on 2011-03-13
1941
    );
1942
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1943
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1944
    $dbi->delete(
1945
        filter => [
1946
            [qw/title author/]  => sub { uc $_[0] }
1947
        ]
1948
    );
1949
    
1950
    # Filter name
1951
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1952
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1953
            title  => 'upper_case',
1954
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1955
        }
update pod
Yuki Kimoto authored on 2011-03-13
1956
    );
1957

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1960
=head2 C<column>
cleanup
Yuki Kimoto authored on 2011-03-21
1961

            
1962
    my $column = $self->column(book => ['author', 'title']);
1963

            
1964
Create column clause. The follwoing column clause is created.
1965

            
1966
    book.author as book__author,
1967
    book.title as book__title
1968

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

            
1971
Get L<DBIx::Custom::Query> object instead of executing SQL.
1972
This is true or false value.
1973

            
1974
    my $query = $dbi->delete(query => 1);
1975

            
1976
You can check SQL.
1977

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1980
=back
1981

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

            
cleanup
yuki-kimoto authored on 2010-08-05
1984
    $dbi->delete_all(table => $table);
packaging one directory
yuki-kimoto authored on 2009-11-16
1985

            
update pod
Yuki Kimoto authored on 2011-03-13
1986
Delete statement to delete all rows.
1987
Options is same as C<delete()>.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1988

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1989
=head2 C<delete_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1990

            
update pod
Yuki Kimoto authored on 2011-03-13
1991
Delete statement, using primary key.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1992

            
1993
    $dbi->delete_at(
1994
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1995
        primary_key => 'id',
1996
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1997
    );
1998

            
update pod
Yuki Kimoto authored on 2011-03-13
1999
This method is same as C<delete()> exept that
2000
C<primary_key> is specified and C<where> is constant value or array refrence.
2001
all option of C<delete()> is available.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2002

            
update pod
Yuki Kimoto authored on 2011-03-13
2003
=over 4
2004

            
2005
=item C<primary_key>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2006

            
update pod
Yuki Kimoto authored on 2011-03-13
2007
Primary key. This is constant value or array reference.
2008
    
2009
    # Constant value
2010
    $dbi->delete(primary_key => 'id');
2011

            
2012
    # Array reference
2013
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2014

            
2015
This is used to create where clause.
2016

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

            
2019
Where clause, created from primary key information.
2020
This is constant value or array reference.
2021

            
2022
    # Constant value
2023
    $dbi->delete(where => 5);
2024

            
2025
    # Array reference
2026
    $dbi->delete(where => [3, 5]);
2027

            
2028
In first examle, the following SQL is created.
2029

            
2030
    delete from book where id = ?;
2031

            
2032
Place holder is set to 5.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2033

            
update pod
Yuki Kimoto authored on 2011-03-13
2034
=back
2035

            
cleanup
yuki-kimoto authored on 2010-10-17
2036
=head2 C<insert>
2037

            
update pod
Yuki Kimoto authored on 2011-03-13
2038
    $dbi->insert(
2039
        table  => 'book', 
2040
        param  => {title => 'Perl', author => 'Ken'}
2041
    );
2042

            
2043
Insert statement.
2044

            
2045
The following opitons are currently available.
2046

            
update pod
Yuki Kimoto authored on 2011-03-13
2047
=over 4
2048

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

            
2051
Table name.
2052

            
2053
    $dbi->insert(table => 'book');
2054

            
2055
=item C<param>
2056

            
2057
Insert data. This is hash reference.
2058

            
2059
    $dbi->insert(param => {title => 'Perl'});
2060

            
2061
=item C<append>
2062

            
2063
Append statement to last of SQL. This is string.
2064

            
2065
    $dbi->insert(append => 'order by title');
2066

            
2067
=item C<filter>
2068

            
2069
Filter, executed before data is send to database. This is array reference.
2070
Filter value is code reference or
2071
filter name registerd by C<register_filter()>.
2072

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

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

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

            
2100
Get L<DBIx::Custom::Query> object instead of executing SQL.
2101
This is true or false value.
2102

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2109
=back
2110

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2111
=head2 C<insert_at()>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2112

            
update pod
Yuki Kimoto authored on 2011-03-13
2113
Insert statement, using primary key.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2114

            
2115
    $dbi->insert_at(
2116
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2117
        primary_key => 'id',
2118
        where => '5',
2119
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2120
    );
2121

            
update pod
Yuki Kimoto authored on 2011-03-13
2122
This method is same as C<insert()> exept that
2123
C<primary_key> is specified and C<where> is constant value or array refrence.
2124
all option of C<insert()> is available.
2125

            
update pod
Yuki Kimoto authored on 2011-03-13
2126
=over 4
2127

            
2128
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2129

            
2130
Primary key. This is constant value or array reference.
2131
    
2132
    # Constant value
2133
    $dbi->insert(primary_key => 'id');
2134

            
2135
    # Array reference
2136
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2137

            
2138
This is used to create parts of insert data.
2139

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

            
2142
Parts of Insert data, create from primary key information.
2143
This is constant value or array reference.
2144

            
2145
    # Constant value
2146
    $dbi->insert(where => 5);
2147

            
2148
    # Array reference
2149
    $dbi->insert(where => [3, 5]);
2150

            
2151
In first examle, the following SQL is created.
2152

            
2153
    insert into book (id, title) values (?, ?);
2154

            
2155
Place holders are set to 5 and 'Perl'.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2156

            
update pod
Yuki Kimoto authored on 2011-03-13
2157
=back
2158

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2159
=head2 C<insert_param_tag>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2160

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2161
    my $insert_param_tag = $dbi->insert_param_tag({title => 'a', age => 2});
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2162

            
2163
Create insert parameter tag.
2164

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2165
    (title, author) values ({? title}, {? author});
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2166

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2174
    lib / MyModel.pm
2175
        / MyModel / book.pm
2176
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2177

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

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

            
2182
    package MyModel;
2183
    
2184
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2185
    
2186
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2187

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2192
    package MyModel::book;
2193
    
2194
    use base 'MyModel';
2195
    
2196
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2197

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2200
    package MyModel::company;
2201
    
2202
    use base 'MyModel';
2203
    
2204
    1;
2205
    
2206
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2207

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

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

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

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

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

            
2219
Merge paramters.
2220

            
2221
$param:
2222

            
2223
    {key1 => [1, 1], key2 => 2}
2224

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

            
2227
    $dbi->method(
2228
        update_or_insert => sub {
2229
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2230
            
2231
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2232
        },
2233
        find_or_create   => sub {
2234
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2235
            
2236
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2237
        }
2238
    );
2239

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

            
2242
    $dbi->update_or_insert;
2243
    $dbi->find_or_create;
2244

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

            
2247
    $dbi->model('book')->method(
2248
        insert => sub { ... },
2249
        update => sub { ... }
2250
    );
2251
    
2252
    my $model = $dbi->model('book');
2253

            
2254
Set and get a L<DBIx::Custom::Model> object,
2255

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

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

            
2260
Create column clause for myself. The follwoing column clause is created.
2261

            
2262
    book.author as author,
2263
    book.title as title
2264

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2267
    my $dbi = DBIx::Custom->new(
2268
        data_source => "dbi:mysql:database=dbname",
2269
        user => 'ken',
2270
        password => '!LFKD%$&',
2271
        dbi_option => {mysql_enable_utf8 => 1}
2272
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2273

            
2274
Create a new L<DBIx::Custom> object.
2275

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

            
2278
    my $not_exists = $dbi->not_exists;
2279

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2283
=head2 C<register_filter>
2284

            
update pod
Yuki Kimoto authored on 2011-03-13
2285
    $dbi->register_filter(
2286
        # Time::Piece object to database DATE format
2287
        tp_to_date => sub {
2288
            my $tp = shift;
2289
            return $tp->strftime('%Y-%m-%d');
2290
        },
2291
        # database DATE format to Time::Piece object
2292
        date_to_tp => sub {
2293
           my $date = shift;
2294
           return Time::Piece->strptime($date, '%Y-%m-%d');
2295
        }
2296
    );
cleanup
yuki-kimoto authored on 2010-10-17
2297
    
update pod
Yuki Kimoto authored on 2011-03-13
2298
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2299

            
update pod
Yuki Kimoto authored on 2011-03-13
2300
=head2 C<register_tag>
cleanup
yuki-kimoto authored on 2010-10-17
2301

            
update pod
Yuki Kimoto authored on 2011-03-13
2302
    $dbi->register_tag(
2303
        update => sub {
2304
            my @columns = @_;
2305
            
2306
            # Update parameters
2307
            my $s = 'set ';
2308
            $s .= "$_ = ?, " for @columns;
2309
            $s =~ s/, $//;
2310
            
2311
            return [$s, \@columns];
2312
        }
2313
    );
cleanup
yuki-kimoto authored on 2010-10-17
2314

            
update pod
Yuki Kimoto authored on 2011-03-13
2315
Register tag, used by C<execute()>.
cleanup
yuki-kimoto authored on 2010-10-17
2316

            
update pod
Yuki Kimoto authored on 2011-03-13
2317
See also L<Tags/Tags> about tag registered by default.
cleanup
yuki-kimoto authored on 2010-10-17
2318

            
update pod
Yuki Kimoto authored on 2011-03-13
2319
Tag parser receive arguments specified in tag.
2320
In the following tag, 'title' and 'author' is parser arguments
cleanup
yuki-kimoto authored on 2010-10-17
2321

            
update pod
Yuki Kimoto authored on 2011-03-13
2322
    {update_param title author} 
cleanup
yuki-kimoto authored on 2010-10-17
2323

            
update pod
Yuki Kimoto authored on 2011-03-13
2324
Tag parser must return array refrence,
2325
first element is the result statement, 
2326
second element is column names corresponding to place holders.
cleanup
yuki-kimoto authored on 2010-10-17
2327

            
update pod
Yuki Kimoto authored on 2011-03-13
2328
In this example, result statement is 
cleanup
yuki-kimoto authored on 2010-10-17
2329

            
update pod
Yuki Kimoto authored on 2011-03-13
2330
    set title = ?, author = ?
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2331

            
update pod
Yuki Kimoto authored on 2011-03-13
2332
Column names is
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2333

            
update pod
Yuki Kimoto authored on 2011-03-13
2334
    ['title', 'author']
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
2335

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2338
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2339
        table  => 'book',
2340
        column => ['author', 'title'],
2341
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2342
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2343
    
update pod
Yuki Kimoto authored on 2011-03-12
2344
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2345

            
2346
The following opitons are currently available.
2347

            
2348
=over 4
2349

            
2350
=item C<table>
2351

            
2352
Table name.
2353

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

            
2356
=item C<column>
2357

            
2358
Column clause. This is array reference or constant value.
2359

            
2360
    # Hash refernce
2361
    $dbi->select(column => ['author', 'title']);
2362
    
2363
    # Constant value
2364
    $dbi->select(column => 'author');
2365

            
2366
Default is '*' unless C<column> is specified.
2367

            
2368
    # Default
2369
    $dbi->select(column => '*');
2370

            
2371
=item C<where>
2372

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2373
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2374
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2375
    
2376
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2377
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2378
    
update pod
Yuki Kimoto authored on 2011-03-12
2379
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2380
    my $where = $dbi->where(
2381
        clause => ['and', '{= author}', '{like title}'],
2382
        param  => {author => 'Ken', title => '%Perl%'}
2383
    );
update pod
Yuki Kimoto authored on 2011-03-12
2384
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2385

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2386
    # Array refrendce (where clause and parameter)
2387
    $dbi->select(where =>
2388
        [
2389
            ['and', '{= author}', '{like title}'],
2390
            {author => 'Ken', title => '%Perl%'}
2391
        ]
2392
    );
2393
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2394
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2395

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

            
2398
    $dbi->select(join =>
2399
        [
2400
            'left outer join company on book.company_id = company_id',
2401
            'left outer join location on company.location_id = location.id'
2402
        ]
2403
    );
2404

            
2405
If column cluase or where clause contain table name like "company.name",
2406
needed join clause is used automatically.
2407

            
2408
    $dbi->select(
2409
        table => 'book',
2410
        column => ['company.location_id as company__location_id'],
2411
        where => {'company.name' => 'Orange'},
2412
        join => [
2413
            'left outer join company on book.company_id = company.id',
2414
            'left outer join location on company.location_id = location.id'
2415
        ]
2416
    );
2417

            
2418
In above select, the following SQL is created.
2419

            
2420
    select company.location_id as company__location_id
2421
    from book
2422
      left outer join company on book.company_id = company.id
2423
    where company.name = Orange
2424

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

            
2427
Parameter shown before where clause.
2428
    
2429
    $dbi->select(
2430
        table => 'table1',
2431
        column => 'table1.key1 as table1_key1, key2, key3',
2432
        where   => {'table1.key2' => 3},
2433
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2434
                  ' as table2 on table1.key1 = table2.key1'],
2435
        param => {'table2.key3' => 5}
2436
    );
2437

            
2438
For example, if you want to contain tag in join clause, 
2439
you can pass parameter by C<param> option.
2440

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

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

            
2445
    $dbi->select(append => 'order by title');
2446

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

            
2449
Wrap statement. This is array reference.
2450

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

            
2453
This option is for Oracle and SQL Server paging process.
2454

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

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

            
2461
    # Basic
2462
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2463
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2464
            title  => sub { uc $_[0] }
2465
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2466
        }
update pod
Yuki Kimoto authored on 2011-03-12
2467
    );
2468
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2469
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2470
    $dbi->select(
2471
        filter => [
2472
            [qw/title author/]  => sub { uc $_[0] }
2473
        ]
2474
    );
2475
    
2476
    # Filter name
2477
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2478
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2479
            title  => 'upper_case',
2480
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2481
        }
update pod
Yuki Kimoto authored on 2011-03-12
2482
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2483

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

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

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

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

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

            
2495
    my $sql = $query->sql;
2496

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

            
2499
Specify database data type.
2500

            
2501
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2502
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2503

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

            
2506
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2507

            
update pod
Yuki Kimoto authored on 2011-03-12
2508
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2509

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2510
=head2 C<select_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2511

            
update pod
Yuki Kimoto authored on 2011-03-12
2512
Select statement, using primary key.
2513

            
2514
    $dbi->select_at(
2515
        table => 'book',
2516
        primary_key => 'id',
2517
        where => '5'
2518
    );
2519

            
update pod
Yuki Kimoto authored on 2011-03-13
2520
This method is same as C<select()> exept that
2521
C<primary_key> is specified and C<where> is constant value or array refrence.
update pod
Yuki Kimoto authored on 2011-03-12
2522
all option of C<select()> is available.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2523

            
update pod
Yuki Kimoto authored on 2011-03-13
2524
=over 4
2525

            
2526
=item C<primary_key>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2527

            
update pod
Yuki Kimoto authored on 2011-03-12
2528
Primary key. This is constant value or array reference.
2529
    
2530
    # Constant value
2531
    $dbi->select(primary_key => 'id');
2532

            
2533
    # Array reference
2534
    $dbi->select(primary_key => ['id1', 'id2' ]);
2535

            
update pod
Yuki Kimoto authored on 2011-03-13
2536
This is used to create where clause.
2537

            
update pod
Yuki Kimoto authored on 2011-03-13
2538
=item C<where>
update pod
Yuki Kimoto authored on 2011-03-12
2539

            
update pod
Yuki Kimoto authored on 2011-03-13
2540
Where clause, created from primary key information.
update pod
Yuki Kimoto authored on 2011-03-12
2541
This is constant value or array reference.
2542

            
2543
    # Constant value
2544
    $dbi->select(where => 5);
2545

            
2546
    # Array reference
2547
    $dbi->select(where => [3, 5]);
2548

            
2549
In first examle, the following SQL is created.
2550

            
2551
    select * from book where id = ?
2552

            
2553
Place holder is set to 5.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2554

            
update pod
Yuki Kimoto authored on 2011-03-13
2555
=back
2556

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2559
    $dbi->update(
2560
        table  => 'book',
2561
        param  => {title => 'Perl'},
2562
        where  => {id => 4}
2563
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2564

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2569
=over 4
2570

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2573
Table name.
2574

            
2575
    $dbi->update(table => 'book');
2576

            
2577
=item C<param>
2578

            
2579
Update data. This is hash reference.
2580

            
2581
    $dbi->update(param => {title => 'Perl'});
2582

            
2583
=item C<where>
2584

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2585
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2586
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2587
    
2588
    # Hash reference
2589
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2590
    
2591
    # DBIx::Custom::Where object
2592
    my $where = $dbi->where(
2593
        clause => ['and', '{= author}', '{like title}'],
2594
        param  => {author => 'Ken', title => '%Perl%'}
2595
    );
2596
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2597
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2598
    # String
2599
    $dbi->update(
2600
        where => ['{= id}', {id => 2}]
2601
        param => {title => 'Perl', id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2602
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2603
    
update pod
Yuki Kimoto authored on 2011-03-13
2604
=item C<append>
2605

            
2606
Append statement to last of SQL. This is string.
2607

            
2608
    $dbi->update(append => 'order by title');
2609

            
2610
=item C<filter>
2611

            
2612
Filter, executed before data is send to database. This is array reference.
2613
Filter value is code reference or
2614
filter name registerd by C<register_filter()>.
2615

            
2616
    # Basic
2617
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2618
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2619
            title  => sub { uc $_[0] }
2620
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2621
        }
update pod
Yuki Kimoto authored on 2011-03-13
2622
    );
2623
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2624
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2625
    $dbi->update(
2626
        filter => [
2627
            [qw/title author/]  => sub { uc $_[0] }
2628
        ]
2629
    );
2630
    
2631
    # Filter name
2632
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2633
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2634
            title  => 'upper_case',
2635
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2636
        }
update pod
Yuki Kimoto authored on 2011-03-13
2637
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2638

            
update pod
Yuki Kimoto authored on 2011-03-13
2639
These filters are added to the C<out> filters, set by C<apply_filter()>.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2640

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

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

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

            
2648
You can check SQL.
2649

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2652
=back
2653

            
cleanup
yuki-kimoto authored on 2010-10-17
2654
=head2 C<update_all>
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2655

            
update pod
Yuki Kimoto authored on 2011-03-13
2656
    $dbi->update_all(table => 'book', param => {title => 'Perl'});
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
2657

            
update pod
Yuki Kimoto authored on 2011-03-13
2658
Update statement to update all rows.
2659
Options is same as C<update()>.
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
2660

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2661
=head2 C<update_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2662

            
update pod
Yuki Kimoto authored on 2011-03-13
2663
Update statement, using primary key.
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2664

            
2665
    $dbi->update_at(
2666
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2667
        primary_key => 'id',
2668
        where => '5',
2669
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2670
    );
2671

            
update pod
Yuki Kimoto authored on 2011-03-13
2672
This method is same as C<update()> exept that
2673
C<primary_key> is specified and C<where> is constant value or array refrence.
2674
all option of C<update()> is available.
2675

            
update pod
Yuki Kimoto authored on 2011-03-13
2676
=over 4
2677

            
2678
=item C<primary_key>
update pod
Yuki Kimoto authored on 2011-03-13
2679

            
2680
Primary key. This is constant value or array reference.
2681
    
2682
    # Constant value
2683
    $dbi->update(primary_key => 'id');
2684

            
2685
    # Array reference
2686
    $dbi->update(primary_key => ['id1', 'id2' ]);
2687

            
2688
This is used to create where clause.
2689

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

            
2692
Where clause, created from primary key information.
2693
This is constant value or array reference.
2694

            
2695
    # Constant value
2696
    $dbi->update(where => 5);
2697

            
2698
    # Array reference
2699
    $dbi->update(where => [3, 5]);
2700

            
2701
In first examle, the following SQL is created.
2702

            
2703
    update book set title = ? where id = ?
2704

            
2705
Place holders are set to 'Perl' and 5.
2706

            
update pod
Yuki Kimoto authored on 2011-03-13
2707
=back
2708

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2709
=head2 C<update_param_tag>
update pod
Yuki Kimoto authored on 2011-03-13
2710

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2711
    my $update_param_tag = $dbi->update_param_tag({title => 'a', age => 2});
update pod
Yuki Kimoto authored on 2011-03-13
2712

            
2713
Create update parameter tag.
2714

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2715
    set title = {? title}, author = {? author}
2716

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2717
You can create tag without 'set '
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2718
by C<no_set> option.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2719

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2720
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2721
        {title => 'a', age => 2}
2722
        {no_set => 1}
2723
    );
2724

            
2725
    title = {? title}, author = {? author}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2726

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2729
    my $where = $dbi->where(
2730
        clause => ['and', '{= title}', '{= author}'],
2731
        param => {title => 'Perl', author => 'Ken'}
2732
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2733

            
2734
Create a new L<DBIx::Custom::Where> object.
2735

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2743
=head1 Tags
2744

            
2745
The following tags is available.
2746

            
2747
=head2 C<?>
2748

            
2749
Placeholder tag.
2750

            
2751
    {? NAME}    ->   ?
2752

            
2753
=head2 C<=>
2754

            
2755
Equal tag.
2756

            
2757
    {= NAME}    ->   NAME = ?
2758

            
2759
=head2 C<E<lt>E<gt>>
2760

            
2761
Not equal tag.
2762

            
2763
    {<> NAME}   ->   NAME <> ?
2764

            
2765
=head2 C<E<lt>>
2766

            
2767
Lower than tag
2768

            
2769
    {< NAME}    ->   NAME < ?
2770

            
2771
=head2 C<E<gt>>
2772

            
2773
Greater than tag
2774

            
2775
    {> NAME}    ->   NAME > ?
2776

            
2777
=head2 C<E<gt>=>
2778

            
2779
Greater than or equal tag
2780

            
2781
    {>= NAME}   ->   NAME >= ?
2782

            
2783
=head2 C<E<lt>=>
2784

            
2785
Lower than or equal tag
2786

            
2787
    {<= NAME}   ->   NAME <= ?
2788

            
2789
=head2 C<like>
2790

            
2791
Like tag
2792

            
2793
    {like NAME}   ->   NAME like ?
2794

            
2795
=head2 C<in>
2796

            
2797
In tag.
2798

            
2799
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2800

            
2801
=head2 C<insert_param>
2802

            
2803
Insert parameter tag.
2804

            
2805
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2806

            
2807
=head2 C<update_param>
2808

            
2809
Updata parameter tag.
2810

            
2811
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2812

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

            
2815
=head2 C<DBIX_CUSTOM_DEBUG>
2816

            
2817
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2818
executed SQL is printed to STDERR.
2819

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

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

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

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

            
2829
C<< <kimoto.yuki at gmail.com> >>
2830

            
2831
L<http://github.com/yuki-kimoto/DBIx-Custom>
2832

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2833
=head1 AUTHOR
2834

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

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

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

            
2841
This program is free software; you can redistribute it and/or modify it
2842
under the same terms as Perl itself.
2843

            
2844
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2845

            
2846