DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2837 lines | 68.982kb
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
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
268
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all 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};
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
287
    my $param            = delete $args{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);
293
        $param = keys %$param ? $self->merge_param($param, $where->param)
294
                              : $where->param;
295
        
296
        # String where
297
        $where_clause = $where->to_string;
298
    }
299
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
300
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
301
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
302

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
974
our %UPDATE_ARGS
975
  = map { $_ => 1 } @COMMON_ARGS, qw/param where append allow_update_all/;
cleanup
yuki-kimoto authored on 2010-10-17
976

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

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

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

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

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

            
1051
sub update_at {
1052
    my ($self, %args) = @_;
1053
    
cleanup
Yuki Kimoto authored on 2011-04-02
1054
    # Arguments
1055
    my $primary_keys = delete $args{primary_key};
1056
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1057
    my $where = delete $args{where};
1058
    
1059

            
1060
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1061
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1062
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
1063
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1064
    }
1065
    
cleanup
Yuki Kimoto authored on 2011-04-02
1066
    # Create where parameter
1067
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1068
    
cleanup
Yuki Kimoto authored on 2011-04-02
1069
    return $self->update(where => $where_param, %args);
1070
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1071

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1093
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1094
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1095
    
1096
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1097
    return DBIx::Custom::Where->new(
1098
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1099
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1100
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1101
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1102
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1103
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1104

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

            
improved error messages
Yuki Kimoto authored on 2011-04-18
1150
sub _create_where_param {
1151
    my ($self, $where, $primary_keys) = @_;
1152
    
1153
    # Create where parameter
1154
    my $where_param = {};
1155
    if ($where) {
1156
        $where = [$where] unless ref $where;
1157
        croak qq{"where" must be constant value or array reference}
1158
            . " (" . (caller 1)[3] . ")"
1159
          unless !ref $where || ref $where eq 'ARRAY';
1160
        
1161
        croak qq{"where" must contain values same count as primary key}
1162
            . " (" . (caller 1)[3] . ")"
1163
          unless @$primary_keys eq @$where;
1164
        
1165
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1166
           $where_param->{$primary_keys->[$i]} = $where->[$i];
1167
        }
1168
    }
1169
    
1170
    return $where_param;
1171
}
1172

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1173
sub _connect {
1174
    my $self = shift;
1175
    
1176
    # Attributes
1177
    my $data_source = $self->data_source;
cleanup
Yuki Kimoto authored on 2011-04-25
1178
    croak qq{"data_source" must be specified } . _subname
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1179
      unless $data_source;
1180
    my $user        = $self->user;
1181
    my $password    = $self->password;
1182
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1183
    
1184
    # Connect
1185
    my $dbh = eval {DBI->connect(
1186
        $data_source,
1187
        $user,
1188
        $password,
1189
        {
1190
            %{$self->default_dbi_option},
1191
            %$dbi_option
1192
        }
1193
    )};
1194
    
1195
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1196
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1197
    
1198
    return $dbh;
1199
}
1200

            
cleanup
yuki-kimoto authored on 2010-10-17
1201
sub _croak {
1202
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1203
    
1204
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1205
    $append ||= "";
1206
    
1207
    # Verbose
1208
    if ($Carp::Verbose) { croak $error }
1209
    
1210
    # Not verbose
1211
    else {
1212
        
1213
        # Remove line and module infromation
1214
        my $at_pos = rindex($error, ' at ');
1215
        $error = substr($error, 0, $at_pos);
1216
        $error =~ s/\s+$//;
1217
        croak "$error$append";
1218
    }
1219
}
1220

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1221
sub _need_tables {
1222
    my ($self, $tree, $need_tables, $tables) = @_;
1223
    
cleanup
Yuki Kimoto authored on 2011-04-02
1224
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1225
    foreach my $table (@$tables) {
1226
        if ($tree->{$table}) {
1227
            $need_tables->{$table} = 1;
1228
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1229
        }
1230
    }
1231
}
1232

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1274
sub _remove_duplicate_table {
1275
    my ($self, $tables, $main_table) = @_;
1276
    
1277
    # Remove duplicate table
1278
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1279
    delete $tables{$main_table} if $main_table;
1280
    
1281
    return [keys %tables, $main_table ? $main_table : ()];
1282
}
1283

            
cleanup
Yuki Kimoto authored on 2011-04-02
1284
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1285
    my ($self, $source) = @_;
1286
    
cleanup
Yuki Kimoto authored on 2011-04-02
1287
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1288
    my $tables = [];
1289
    my $safety_character = $self->safety_character;
1290
    my $q = $self->reserved_word_quote;
1291
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1292
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1293
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1294
    while ($source =~ /$table_re/g) {
1295
        push @$tables, $1;
1296
    }
1297
    
1298
    return $tables;
1299
}
1300

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1343
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1344
__PACKAGE__->attr(
1345
    dbi_options => sub { {} },
1346
    filter_check  => 1
1347
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1348

            
cleanup
Yuki Kimoto authored on 2011-01-25
1349
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1350
sub default_bind_filter {
1351
    my $self = shift;
1352
    
1353
    if (@_) {
1354
        my $fname = $_[0];
1355
        
1356
        if (@_ && !$fname) {
1357
            $self->{default_out_filter} = undef;
1358
        }
1359
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1360
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1361
              unless exists $self->filters->{$fname};
1362
        
1363
            $self->{default_out_filter} = $self->filters->{$fname};
1364
        }
1365
        return $self;
1366
    }
1367
    
1368
    return $self->{default_out_filter};
1369
}
1370

            
cleanup
Yuki Kimoto authored on 2011-01-25
1371
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1372
sub default_fetch_filter {
1373
    my $self = shift;
1374
    
1375
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1376
        my $fname = $_[0];
1377

            
cleanup
Yuki Kimoto authored on 2011-01-12
1378
        if (@_ && !$fname) {
1379
            $self->{default_in_filter} = undef;
1380
        }
1381
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1382
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1383
              unless exists $self->filters->{$fname};
1384
        
1385
            $self->{default_in_filter} = $self->filters->{$fname};
1386
        }
1387
        
1388
        return $self;
1389
    }
1390
    
many changed
Yuki Kimoto authored on 2011-01-23
1391
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1392
}
1393

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1394
# DEPRECATED!
1395
sub insert_param {
1396
    warn "insert_param is renamed to insert_param_tag."
1397
       . " insert_param is DEPRECATED!";
1398
    return shift->insert_param_tag(@_);
1399
}
1400

            
cleanup
Yuki Kimoto authored on 2011-01-25
1401
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1402
sub register_tag_processor {
1403
    return shift->query_builder->register_tag_processor(@_);
1404
}
1405

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1406
# DEPRECATED!
1407
sub update_param {
1408
    warn "update_param is renamed to update_param_tag."
1409
       . " update_param is DEPRECATED!";
1410
    return shift->update_param_tag(@_);
1411
}
cleanup
Yuki Kimoto authored on 2011-03-08
1412
# DEPRECATED!
1413
sub _push_relation {
1414
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1415
    
1416
    if (keys %{$relation || {}}) {
1417
        push @$sql, $need_where ? 'where' : 'and';
1418
        foreach my $rcolumn (keys %$relation) {
1419
            my $table1 = (split (/\./, $rcolumn))[0];
1420
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1421
            push @$tables, ($table1, $table2);
1422
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1423
        }
1424
    }
1425
    pop @$sql if $sql->[-1] eq 'and';    
1426
}
1427

            
1428
# DEPRECATED!
1429
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1430
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1431
    
1432
    if (keys %{$relation || {}}) {
1433
        foreach my $rcolumn (keys %$relation) {
1434
            my $table1 = (split (/\./, $rcolumn))[0];
1435
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1436
            my $table1_exists;
1437
            my $table2_exists;
1438
            foreach my $table (@$tables) {
1439
                $table1_exists = 1 if $table eq $table1;
1440
                $table2_exists = 1 if $table eq $table2;
1441
            }
1442
            unshift @$tables, $table1 unless $table1_exists;
1443
            unshift @$tables, $table2 unless $table2_exists;
1444
        }
1445
    }
1446
}
1447

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1450
=head1 NAME
1451

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

            
1454
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1455

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1456
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1457
    
1458
    # Connect
1459
    my $dbi = DBIx::Custom->connect(
1460
        data_source => "dbi:mysql:database=dbname",
1461
        user => 'ken',
1462
        password => '!LFKD%$&',
1463
        dbi_option => {mysql_enable_utf8 => 1}
1464
    );
cleanup
yuki-kimoto authored on 2010-08-05
1465

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1466
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1467
    $dbi->insert(
1468
        table  => 'book',
1469
        param  => {title => 'Perl', author => 'Ken'}
1470
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1471
    
1472
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1473
    $dbi->update(
1474
        table  => 'book', 
1475
        param  => {title => 'Perl', author => 'Ken'}, 
1476
        where  => {id => 5},
1477
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1478
    
1479
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1480
    $dbi->delete(
1481
        table  => 'book',
1482
        where  => {author => 'Ken'},
1483
    );
cleanup
yuki-kimoto authored on 2010-08-05
1484

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

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

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

            
1523
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1524

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1529
There are many basic methods to execute various queries.
1530
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1531
C<delete_all()>, C<select()>,
1532
C<insert_at()>, C<update_at()>, 
1533
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1534

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1535
=item *
1536

            
1537
Filter when data is send or receive.
1538

            
1539
=item *
1540

            
1541
Data filtering system
1542

            
1543
=item *
1544

            
1545
Model support.
1546

            
1547
=item *
1548

            
1549
Generate where clause dinamically.
1550

            
1551
=item *
1552

            
1553
Generate join clause dinamically.
1554

            
1555
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1556

            
1557
=head1 GUIDE
1558

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

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

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

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

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

            
1569
    my $connector = $dbi->connector;
1570
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1571

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

            
1575
This is L<DBIx::Connector> example. Please pass
1576
C<default_dbi_option> to L<DBIx::Connector>.
1577

            
1578
    my $connector = DBIx::Connector->new(
1579
        "dbi:mysql:database=$DATABASE",
1580
        $USER,
1581
        $PASSWORD,
1582
        DBIx::Custom->new->default_dbi_option
1583
    );
1584
    
1585
    my $dbi = DBIx::Custom->new(connector => $connector);
1586

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

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

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

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

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

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

            
1602
=head2 C<default_dbi_option>
1603

            
1604
    my $default_dbi_option = $dbi->default_dbi_option;
1605
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1606

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1610
    {
1611
        RaiseError => 1,
1612
        PrintError => 0,
1613
        AutoCommit => 1,
1614
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1615

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

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

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

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

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

            
1628
    my $models = $dbi->models;
1629
    $dbi       = $dbi->models(\%models);
1630

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1633
=head2 C<password>
1634

            
1635
    my $password = $dbi->password;
1636
    $dbi         = $dbi->password('lkj&le`@s');
1637

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

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

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

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

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

            
1649
     my reserved_word_quote = $dbi->reserved_word_quote;
1650
     $dbi                   = $dbi->reserved_word_quote('"');
1651

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1671
    my $user = $dbi->user;
1672
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1673

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1684
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1685
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1686
        'issue_date' => {
1687
            out => 'tp_to_date',
1688
            in  => 'date_to_tp',
1689
            end => 'tp_to_displaydate'
1690
        },
1691
        'write_date' => {
1692
            out => 'tp_to_date',
1693
            in  => 'date_to_tp',
1694
            end => 'tp_to_displaydate'
1695
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1696
    );
1697

            
update pod
Yuki Kimoto authored on 2011-03-13
1698
Apply filter to columns.
1699
C<out> filter is executed before data is send to database.
1700
C<in> filter is executed after a row is fetch.
1701
C<end> filter is execute after C<in> filter is executed.
1702

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1705
       PETTERN         EXAMPLE
1706
    1. Column        : author
1707
    2. Table.Column  : book.author
1708
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1709

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

            
1713
You can set multiple filters at once.
1714

            
1715
    $dbi->apply_filter(
1716
        'book',
1717
        [qw/issue_date write_date/] => {
1718
            out => 'tp_to_date',
1719
            in  => 'date_to_tp',
1720
            end => 'tp_to_displaydate'
1721
        }
1722
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1723

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1726
    my $dbi = DBIx::Custom->connect(
1727
        data_source => "dbi:mysql:database=dbname",
1728
        user => 'ken',
1729
        password => '!LFKD%$&',
1730
        dbi_option => {mysql_enable_utf8 => 1}
1731
    );
1732

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1741
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1742
        table => 'book',
1743
        primary_key => 'id',
1744
        join => [
1745
            'inner join company on book.comparny_id = company.id'
1746
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1747
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1748
            publish_date => {
1749
                out => 'tp_to_date',
1750
                in => 'date_to_tp',
1751
                end => 'tp_to_displaydate'
1752
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1753
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1754
    );
1755

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

            
1759
   $dbi->model('book')->select(...);
1760

            
cleanup
yuki-kimoto authored on 2010-10-17
1761
=head2 C<create_query>
1762
    
1763
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1764
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1765
    );
update document
yuki-kimoto authored on 2009-11-19
1766

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

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

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

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

            
1777
    my $dbh = $dbi->dbh;
1778

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

            
1782
=head2 C<each_column>
1783

            
1784
    $dbi->each_column(
1785
        sub {
1786
            my ($dbi, $table, $column, $column_info) = @_;
1787
            
1788
            my $type = $column_info->{TYPE_NAME};
1789
            
1790
            if ($type eq 'DATE') {
1791
                # ...
1792
            }
1793
        }
1794
    );
1795

            
1796
Iterate all column informations of all table from database.
1797
Argument is callback when one column is found.
1798
Callback receive four arguments, dbi object, table name,
1799
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1800

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1803
    my $result = $dbi->execute(
1804
        "select * from book where {= title} and {like author}",
1805
        param => {title => 'Perl', author => '%Ken%'}
1806
    );
1807

            
1808
Execute SQL, containing tags.
1809
Return value is L<DBIx::Custom::Result> in select statement, or
1810
the count of affected rows in insert, update, delete statement.
1811

            
1812
Tag is turned into the statement containing place holder
1813
before SQL is executed.
1814

            
1815
    select * from where title = ? and author like ?;
1816

            
1817
See also L<Tags/Tags>.
1818

            
1819
The following opitons are currently available.
1820

            
1821
=over 4
1822

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

            
1825
Table names for filtering.
1826

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

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

            
1832

            
1833

            
1834

            
1835

            
1836

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

            
1839
Filter, executed before data is send to database. This is array reference.
1840
Filter value is code reference or
1841
filter name registerd by C<register_filter()>.
1842

            
1843
    # Basic
1844
    $dbi->execute(
1845
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1846
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1847
            title  => sub { uc $_[0] }
1848
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1849
        }
update pod
Yuki Kimoto authored on 2011-03-13
1850
    );
1851
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1852
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1853
    $dbi->execute(
1854
        $sql,
1855
        filter => [
1856
            [qw/title author/]  => sub { uc $_[0] }
1857
        ]
1858
    );
1859
    
1860
    # Filter name
1861
    $dbi->execute(
1862
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1863
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1864
            title  => 'upper_case',
1865
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1866
        }
update pod
Yuki Kimoto authored on 2011-03-13
1867
    );
1868

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

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

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

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

            
1877
Delete statement.
1878

            
1879
The following opitons are currently available.
1880

            
update pod
Yuki Kimoto authored on 2011-03-13
1881
=over 4
1882

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

            
1885
Table name.
1886

            
1887
    $dbi->delete(table => 'book');
1888

            
1889
=item C<where>
1890

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1891
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1892
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1893
    
1894
    # Hash reference
1895
    $dbi->delete(where => {title => 'Perl'});
1896
    
1897
    # DBIx::Custom::Where object
1898
    my $where = $dbi->where(
1899
        clause => ['and', '{= author}', '{like title}'],
1900
        param  => {author => 'Ken', title => '%Perl%'}
1901
    );
1902
    $dbi->delete(where => $where);
1903

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1904
    # Array refrendce (where clause and parameter)
1905
    $dbi->delete(where =>
1906
        [
1907
            ['and', '{= author}', '{like title}'],
1908
            {author => 'Ken', title => '%Perl%'}
1909
        ]
1910
    );
1911
    
update pod
Yuki Kimoto authored on 2011-03-13
1912
=item C<append>
1913

            
1914
Append statement to last of SQL. This is string.
1915

            
1916
    $dbi->delete(append => 'order by title');
1917

            
1918
=item C<filter>
1919

            
1920
Filter, executed before data is send to database. This is array reference.
1921
Filter value is code reference or
1922
filter name registerd by C<register_filter()>.
1923

            
1924
    # Basic
1925
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1926
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1927
            title  => sub { uc $_[0] }
1928
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1929
        }
update pod
Yuki Kimoto authored on 2011-03-13
1930
    );
1931
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1932
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1933
    $dbi->delete(
1934
        filter => [
1935
            [qw/title author/]  => sub { uc $_[0] }
1936
        ]
1937
    );
1938
    
1939
    # Filter name
1940
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1941
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1942
            title  => 'upper_case',
1943
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1944
        }
update pod
Yuki Kimoto authored on 2011-03-13
1945
    );
1946

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

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

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

            
1953
Create column clause. The follwoing column clause is created.
1954

            
1955
    book.author as book__author,
1956
    book.title as book__title
1957

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

            
1960
Get L<DBIx::Custom::Query> object instead of executing SQL.
1961
This is true or false value.
1962

            
1963
    my $query = $dbi->delete(query => 1);
1964

            
1965
You can check SQL.
1966

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1969
=back
1970

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

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

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

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

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

            
1982
    $dbi->delete_at(
1983
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1984
        primary_key => 'id',
1985
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1986
    );
1987

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1992
=over 4
1993

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1996
Primary key. This is constant value or array reference.
1997
    
1998
    # Constant value
1999
    $dbi->delete(primary_key => 'id');
2000

            
2001
    # Array reference
2002
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2003

            
2004
This is used to create where clause.
2005

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

            
2008
Where clause, created from primary key information.
2009
This is constant value or array reference.
2010

            
2011
    # Constant value
2012
    $dbi->delete(where => 5);
2013

            
2014
    # Array reference
2015
    $dbi->delete(where => [3, 5]);
2016

            
2017
In first examle, the following SQL is created.
2018

            
2019
    delete from book where id = ?;
2020

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2023
=back
2024

            
cleanup
yuki-kimoto authored on 2010-10-17
2025
=head2 C<insert>
2026

            
update pod
Yuki Kimoto authored on 2011-03-13
2027
    $dbi->insert(
2028
        table  => 'book', 
2029
        param  => {title => 'Perl', author => 'Ken'}
2030
    );
2031

            
2032
Insert statement.
2033

            
2034
The following opitons are currently available.
2035

            
update pod
Yuki Kimoto authored on 2011-03-13
2036
=over 4
2037

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

            
2040
Table name.
2041

            
2042
    $dbi->insert(table => 'book');
2043

            
2044
=item C<param>
2045

            
2046
Insert data. This is hash reference.
2047

            
2048
    $dbi->insert(param => {title => 'Perl'});
2049

            
2050
=item C<append>
2051

            
2052
Append statement to last of SQL. This is string.
2053

            
2054
    $dbi->insert(append => 'order by title');
2055

            
2056
=item C<filter>
2057

            
2058
Filter, executed before data is send to database. This is array reference.
2059
Filter value is code reference or
2060
filter name registerd by C<register_filter()>.
2061

            
2062
    # Basic
2063
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2064
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2065
            title  => sub { uc $_[0] }
2066
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2067
        }
update pod
Yuki Kimoto authored on 2011-03-13
2068
    );
2069
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2070
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2071
    $dbi->insert(
2072
        filter => [
2073
            [qw/title author/]  => sub { uc $_[0] }
2074
        ]
2075
    );
2076
    
2077
    # Filter name
2078
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2079
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2080
            title  => 'upper_case',
2081
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2082
        }
update pod
Yuki Kimoto authored on 2011-03-13
2083
    );
2084

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

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

            
2089
Get L<DBIx::Custom::Query> object instead of executing SQL.
2090
This is true or false value.
2091

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2098
=back
2099

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

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

            
2104
    $dbi->insert_at(
2105
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2106
        primary_key => 'id',
2107
        where => '5',
2108
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2109
    );
2110

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2115
=over 4
2116

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

            
2119
Primary key. This is constant value or array reference.
2120
    
2121
    # Constant value
2122
    $dbi->insert(primary_key => 'id');
2123

            
2124
    # Array reference
2125
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2126

            
2127
This is used to create parts of insert data.
2128

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

            
2131
Parts of Insert data, create from primary key information.
2132
This is constant value or array reference.
2133

            
2134
    # Constant value
2135
    $dbi->insert(where => 5);
2136

            
2137
    # Array reference
2138
    $dbi->insert(where => [3, 5]);
2139

            
2140
In first examle, the following SQL is created.
2141

            
2142
    insert into book (id, title) values (?, ?);
2143

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2146
=back
2147

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

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

            
2152
Create insert parameter tag.
2153

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2163
    lib / MyModel.pm
2164
        / MyModel / book.pm
2165
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2166

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

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

            
2171
    package MyModel;
2172
    
2173
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2174
    
2175
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2176

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2181
    package MyModel::book;
2182
    
2183
    use base 'MyModel';
2184
    
2185
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2186

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2189
    package MyModel::company;
2190
    
2191
    use base 'MyModel';
2192
    
2193
    1;
2194
    
2195
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2196

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

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

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

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

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

            
2208
Merge paramters.
2209

            
2210
$param:
2211

            
2212
    {key1 => [1, 1], key2 => 2}
2213

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

            
2216
    $dbi->method(
2217
        update_or_insert => sub {
2218
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2219
            
2220
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2221
        },
2222
        find_or_create   => sub {
2223
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2224
            
2225
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2226
        }
2227
    );
2228

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

            
2231
    $dbi->update_or_insert;
2232
    $dbi->find_or_create;
2233

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

            
2236
    $dbi->model('book')->method(
2237
        insert => sub { ... },
2238
        update => sub { ... }
2239
    );
2240
    
2241
    my $model = $dbi->model('book');
2242

            
2243
Set and get a L<DBIx::Custom::Model> object,
2244

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

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

            
2249
Create column clause for myself. The follwoing column clause is created.
2250

            
2251
    book.author as author,
2252
    book.title as title
2253

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2256
    my $dbi = DBIx::Custom->new(
2257
        data_source => "dbi:mysql:database=dbname",
2258
        user => 'ken',
2259
        password => '!LFKD%$&',
2260
        dbi_option => {mysql_enable_utf8 => 1}
2261
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2262

            
2263
Create a new L<DBIx::Custom> object.
2264

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

            
2267
    my $not_exists = $dbi->not_exists;
2268

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2272
=head2 C<register_filter>
2273

            
update pod
Yuki Kimoto authored on 2011-03-13
2274
    $dbi->register_filter(
2275
        # Time::Piece object to database DATE format
2276
        tp_to_date => sub {
2277
            my $tp = shift;
2278
            return $tp->strftime('%Y-%m-%d');
2279
        },
2280
        # database DATE format to Time::Piece object
2281
        date_to_tp => sub {
2282
           my $date = shift;
2283
           return Time::Piece->strptime($date, '%Y-%m-%d');
2284
        }
2285
    );
cleanup
yuki-kimoto authored on 2010-10-17
2286
    
update pod
Yuki Kimoto authored on 2011-03-13
2287
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2288

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2291
    $dbi->register_tag(
2292
        update => sub {
2293
            my @columns = @_;
2294
            
2295
            # Update parameters
2296
            my $s = 'set ';
2297
            $s .= "$_ = ?, " for @columns;
2298
            $s =~ s/, $//;
2299
            
2300
            return [$s, \@columns];
2301
        }
2302
    );
cleanup
yuki-kimoto authored on 2010-10-17
2303

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2327
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2328
        table  => 'book',
2329
        column => ['author', 'title'],
2330
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2331
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2332
    
update pod
Yuki Kimoto authored on 2011-03-12
2333
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2334

            
2335
The following opitons are currently available.
2336

            
2337
=over 4
2338

            
2339
=item C<table>
2340

            
2341
Table name.
2342

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

            
2345
=item C<column>
2346

            
2347
Column clause. This is array reference or constant value.
2348

            
2349
    # Hash refernce
2350
    $dbi->select(column => ['author', 'title']);
2351
    
2352
    # Constant value
2353
    $dbi->select(column => 'author');
2354

            
2355
Default is '*' unless C<column> is specified.
2356

            
2357
    # Default
2358
    $dbi->select(column => '*');
2359

            
2360
=item C<where>
2361

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2362
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2363
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2364
    
2365
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2366
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2367
    
update pod
Yuki Kimoto authored on 2011-03-12
2368
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2369
    my $where = $dbi->where(
2370
        clause => ['and', '{= author}', '{like title}'],
2371
        param  => {author => 'Ken', title => '%Perl%'}
2372
    );
update pod
Yuki Kimoto authored on 2011-03-12
2373
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2374

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2375
    # Array refrendce (where clause and parameter)
2376
    $dbi->select(where =>
2377
        [
2378
            ['and', '{= author}', '{like title}'],
2379
            {author => 'Ken', title => '%Perl%'}
2380
        ]
2381
    );
2382
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2383
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2384

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

            
2387
    $dbi->select(join =>
2388
        [
2389
            'left outer join company on book.company_id = company_id',
2390
            'left outer join location on company.location_id = location.id'
2391
        ]
2392
    );
2393

            
2394
If column cluase or where clause contain table name like "company.name",
2395
needed join clause is used automatically.
2396

            
2397
    $dbi->select(
2398
        table => 'book',
2399
        column => ['company.location_id as company__location_id'],
2400
        where => {'company.name' => 'Orange'},
2401
        join => [
2402
            'left outer join company on book.company_id = company.id',
2403
            'left outer join location on company.location_id = location.id'
2404
        ]
2405
    );
2406

            
2407
In above select, the following SQL is created.
2408

            
2409
    select company.location_id as company__location_id
2410
    from book
2411
      left outer join company on book.company_id = company.id
2412
    where company.name = Orange
2413

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

            
2416
Parameter shown before where clause.
2417
    
2418
    $dbi->select(
2419
        table => 'table1',
2420
        column => 'table1.key1 as table1_key1, key2, key3',
2421
        where   => {'table1.key2' => 3},
2422
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2423
                  ' as table2 on table1.key1 = table2.key1'],
2424
        param => {'table2.key3' => 5}
2425
    );
2426

            
2427
For example, if you want to contain tag in join clause, 
2428
you can pass parameter by C<param> option.
2429

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

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

            
2434
    $dbi->select(append => 'order by title');
2435

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

            
2438
Wrap statement. This is array reference.
2439

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

            
2442
This option is for Oracle and SQL Server paging process.
2443

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

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

            
2450
    # Basic
2451
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2452
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2453
            title  => sub { uc $_[0] }
2454
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2455
        }
update pod
Yuki Kimoto authored on 2011-03-12
2456
    );
2457
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2458
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2459
    $dbi->select(
2460
        filter => [
2461
            [qw/title author/]  => sub { uc $_[0] }
2462
        ]
2463
    );
2464
    
2465
    # Filter name
2466
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2467
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2468
            title  => 'upper_case',
2469
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2470
        }
update pod
Yuki Kimoto authored on 2011-03-12
2471
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2472

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

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

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

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

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

            
2484
    my $sql = $query->sql;
2485

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

            
2488
Specify database data type.
2489

            
2490
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2491
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2492

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

            
2495
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2496

            
update pod
Yuki Kimoto authored on 2011-03-12
2497
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2498

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

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

            
2503
    $dbi->select_at(
2504
        table => 'book',
2505
        primary_key => 'id',
2506
        where => '5'
2507
    );
2508

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2513
=over 4
2514

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2517
Primary key. This is constant value or array reference.
2518
    
2519
    # Constant value
2520
    $dbi->select(primary_key => 'id');
2521

            
2522
    # Array reference
2523
    $dbi->select(primary_key => ['id1', 'id2' ]);
2524

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

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

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

            
2532
    # Constant value
2533
    $dbi->select(where => 5);
2534

            
2535
    # Array reference
2536
    $dbi->select(where => [3, 5]);
2537

            
2538
In first examle, the following SQL is created.
2539

            
2540
    select * from book where id = ?
2541

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2544
=back
2545

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2548
    $dbi->update(
2549
        table  => 'book',
2550
        param  => {title => 'Perl'},
2551
        where  => {id => 4}
2552
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2553

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2558
=over 4
2559

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2562
Table name.
2563

            
2564
    $dbi->update(table => 'book');
2565

            
2566
=item C<param>
2567

            
2568
Update data. This is hash reference.
2569

            
2570
    $dbi->update(param => {title => 'Perl'});
2571

            
2572
=item C<where>
2573

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2574
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2575
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2576
    
2577
    # Hash reference
2578
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2579
    
2580
    # DBIx::Custom::Where object
2581
    my $where = $dbi->where(
2582
        clause => ['and', '{= author}', '{like title}'],
2583
        param  => {author => 'Ken', title => '%Perl%'}
2584
    );
2585
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2586
    
2587
    # Array refrendce (where clause and parameter)
2588
    $dbi->update(where =>
2589
        [
2590
            ['and', '{= author}', '{like title}'],
2591
            {author => 'Ken', title => '%Perl%'}
2592
        ]
2593
    );
update pod
Yuki Kimoto authored on 2011-03-13
2594

            
2595
=item C<append>
2596

            
2597
Append statement to last of SQL. This is string.
2598

            
2599
    $dbi->update(append => 'order by title');
2600

            
2601
=item C<filter>
2602

            
2603
Filter, executed before data is send to database. This is array reference.
2604
Filter value is code reference or
2605
filter name registerd by C<register_filter()>.
2606

            
2607
    # Basic
2608
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2609
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2610
            title  => sub { uc $_[0] }
2611
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2612
        }
update pod
Yuki Kimoto authored on 2011-03-13
2613
    );
2614
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2615
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2616
    $dbi->update(
2617
        filter => [
2618
            [qw/title author/]  => sub { uc $_[0] }
2619
        ]
2620
    );
2621
    
2622
    # Filter name
2623
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2624
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2625
            title  => 'upper_case',
2626
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2627
        }
update pod
Yuki Kimoto authored on 2011-03-13
2628
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2629

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

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

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

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

            
2639
You can check SQL.
2640

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2643
=back
2644

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

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

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

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

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

            
2656
    $dbi->update_at(
2657
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2658
        primary_key => 'id',
2659
        where => '5',
2660
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2661
    );
2662

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2667
=over 4
2668

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

            
2671
Primary key. This is constant value or array reference.
2672
    
2673
    # Constant value
2674
    $dbi->update(primary_key => 'id');
2675

            
2676
    # Array reference
2677
    $dbi->update(primary_key => ['id1', 'id2' ]);
2678

            
2679
This is used to create where clause.
2680

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

            
2683
Where clause, created from primary key information.
2684
This is constant value or array reference.
2685

            
2686
    # Constant value
2687
    $dbi->update(where => 5);
2688

            
2689
    # Array reference
2690
    $dbi->update(where => [3, 5]);
2691

            
2692
In first examle, the following SQL is created.
2693

            
2694
    update book set title = ? where id = ?
2695

            
2696
Place holders are set to 'Perl' and 5.
2697

            
update pod
Yuki Kimoto authored on 2011-03-13
2698
=back
2699

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

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

            
2704
Create update parameter tag.
2705

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2711
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2712
        {title => 'a', age => 2}
2713
        {no_set => 1}
2714
    );
2715

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2720
    my $where = $dbi->where(
2721
        clause => ['and', '{= title}', '{= author}'],
2722
        param => {title => 'Perl', author => 'Ken'}
2723
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2724

            
2725
Create a new L<DBIx::Custom::Where> object.
2726

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2734
=head1 Tags
2735

            
2736
The following tags is available.
2737

            
2738
=head2 C<?>
2739

            
2740
Placeholder tag.
2741

            
2742
    {? NAME}    ->   ?
2743

            
2744
=head2 C<=>
2745

            
2746
Equal tag.
2747

            
2748
    {= NAME}    ->   NAME = ?
2749

            
2750
=head2 C<E<lt>E<gt>>
2751

            
2752
Not equal tag.
2753

            
2754
    {<> NAME}   ->   NAME <> ?
2755

            
2756
=head2 C<E<lt>>
2757

            
2758
Lower than tag
2759

            
2760
    {< NAME}    ->   NAME < ?
2761

            
2762
=head2 C<E<gt>>
2763

            
2764
Greater than tag
2765

            
2766
    {> NAME}    ->   NAME > ?
2767

            
2768
=head2 C<E<gt>=>
2769

            
2770
Greater than or equal tag
2771

            
2772
    {>= NAME}   ->   NAME >= ?
2773

            
2774
=head2 C<E<lt>=>
2775

            
2776
Lower than or equal tag
2777

            
2778
    {<= NAME}   ->   NAME <= ?
2779

            
2780
=head2 C<like>
2781

            
2782
Like tag
2783

            
2784
    {like NAME}   ->   NAME like ?
2785

            
2786
=head2 C<in>
2787

            
2788
In tag.
2789

            
2790
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2791

            
2792
=head2 C<insert_param>
2793

            
2794
Insert parameter tag.
2795

            
2796
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2797

            
2798
=head2 C<update_param>
2799

            
2800
Updata parameter tag.
2801

            
2802
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2803

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

            
2806
=head2 C<DBIX_CUSTOM_DEBUG>
2807

            
2808
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2809
executed SQL is printed to STDERR.
2810

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

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

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

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

            
2820
C<< <kimoto.yuki at gmail.com> >>
2821

            
2822
L<http://github.com/yuki-kimoto/DBIx-Custom>
2823

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2824
=head1 AUTHOR
2825

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

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

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

            
2832
This program is free software; you can redistribute it and/or modify it
2833
under the same terms as Perl itself.
2834

            
2835
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2836

            
2837