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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1548
Filter when data is send or receive.
1549

            
1550
=item *
1551

            
1552
Data filtering system
1553

            
1554
=item *
1555

            
1556
Model support.
1557

            
1558
=item *
1559

            
1560
Generate where clause dinamically.
1561

            
1562
=item *
1563

            
1564
Generate join clause dinamically.
1565

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

            
1568
=head1 GUIDE
1569

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1613
=head2 C<default_dbi_option>
1614

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1724
You can set multiple filters at once.
1725

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1793
=head2 C<each_column>
1794

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

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

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

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

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

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

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

            
1828
See also L<Tags/Tags>.
1829

            
1830
The following opitons are currently available.
1831

            
1832
=over 4
1833

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

            
1836
Table names for filtering.
1837

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

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

            
1843

            
1844

            
1845

            
1846

            
1847

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

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

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

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

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

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

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

            
1888
Delete statement.
1889

            
1890
The following opitons are currently available.
1891

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

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

            
1896
Table name.
1897

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

            
1900
=item C<where>
1901

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
1915
    # String(with where_param option)
1916
    $dbi->delete(
1917
        where => '{like title}',
1918
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1919
    );
1920
    
update pod
Yuki Kimoto authored on 2011-03-13
1921
=item C<append>
1922

            
1923
Append statement to last of SQL. This is string.
1924

            
1925
    $dbi->delete(append => 'order by title');
1926

            
1927
=item C<filter>
1928

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

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

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

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

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

            
1962
Create column clause. The follwoing column clause is created.
1963

            
1964
    book.author as book__author,
1965
    book.title as book__title
1966

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

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

            
1972
    my $query = $dbi->delete(query => 1);
1973

            
1974
You can check SQL.
1975

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1978
=back
1979

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2001
=over 4
2002

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

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

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

            
2013
This is used to create where clause.
2014

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

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

            
2020
    # Constant value
2021
    $dbi->delete(where => 5);
2022

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

            
2026
In first examle, the following SQL is created.
2027

            
2028
    delete from book where id = ?;
2029

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2032
=back
2033

            
cleanup
yuki-kimoto authored on 2010-10-17
2034
=head2 C<insert>
2035

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

            
2041
Insert statement.
2042

            
2043
The following opitons are currently available.
2044

            
update pod
Yuki Kimoto authored on 2011-03-13
2045
=over 4
2046

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

            
2049
Table name.
2050

            
2051
    $dbi->insert(table => 'book');
2052

            
2053
=item C<param>
2054

            
2055
Insert data. This is hash reference.
2056

            
2057
    $dbi->insert(param => {title => 'Perl'});
2058

            
2059
=item C<append>
2060

            
2061
Append statement to last of SQL. This is string.
2062

            
2063
    $dbi->insert(append => 'order by title');
2064

            
2065
=item C<filter>
2066

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2107
=back
2108

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2124
=over 4
2125

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

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

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

            
2136
This is used to create parts of insert data.
2137

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

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

            
2143
    # Constant value
2144
    $dbi->insert(where => 5);
2145

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

            
2149
In first examle, the following SQL is created.
2150

            
2151
    insert into book (id, title) values (?, ?);
2152

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2155
=back
2156

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

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

            
2161
Create insert parameter tag.
2162

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2217
Merge paramters.
2218

            
2219
$param:
2220

            
2221
    {key1 => [1, 1], key2 => 2}
2222

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

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

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

            
2240
    $dbi->update_or_insert;
2241
    $dbi->find_or_create;
2242

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

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

            
2252
Set and get a L<DBIx::Custom::Model> object,
2253

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

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

            
2258
Create column clause for myself. The follwoing column clause is created.
2259

            
2260
    book.author as author,
2261
    book.title as title
2262

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

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

            
2272
Create a new L<DBIx::Custom> object.
2273

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

            
2276
    my $not_exists = $dbi->not_exists;
2277

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2281
=head2 C<register_filter>
2282

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2344
The following opitons are currently available.
2345

            
2346
=over 4
2347

            
2348
=item C<table>
2349

            
2350
Table name.
2351

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

            
2354
=item C<column>
2355

            
2356
Column clause. This is array reference or constant value.
2357

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

            
2364
Default is '*' unless C<column> is specified.
2365

            
2366
    # Default
2367
    $dbi->select(column => '*');
2368

            
2369
=item C<where>
2370

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

            
updated pod
Yuki Kimoto authored on 2011-04-25
2384
    # String(with where_param option)
2385
    $dbi->select(
2386
        where => '{like title}',
2387
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2388
    );
2389
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2390
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2391

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

            
2394
    $dbi->select(join =>
2395
        [
2396
            'left outer join company on book.company_id = company_id',
2397
            'left outer join location on company.location_id = location.id'
2398
        ]
2399
    );
2400

            
2401
If column cluase or where clause contain table name like "company.name",
2402
needed join clause is used automatically.
2403

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

            
2414
In above select, the following SQL is created.
2415

            
2416
    select company.location_id as company__location_id
2417
    from book
2418
      left outer join company on book.company_id = company.id
2419
    where company.name = Orange
2420

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

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

            
2434
For example, if you want to contain tag in join clause, 
2435
you can pass parameter by C<param> option.
2436

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

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

            
2441
    $dbi->select(append => 'order by title');
2442

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

            
2445
Wrap statement. This is array reference.
2446

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

            
2449
This option is for Oracle and SQL Server paging process.
2450

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

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

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

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

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

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

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

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

            
2491
    my $sql = $query->sql;
2492

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

            
2495
Specify database data type.
2496

            
2497
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2498
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2499

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

            
2502
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2503

            
update pod
Yuki Kimoto authored on 2011-03-12
2504
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2505

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

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

            
2510
    $dbi->select_at(
2511
        table => 'book',
2512
        primary_key => 'id',
2513
        where => '5'
2514
    );
2515

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2520
=over 4
2521

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

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

            
2529
    # Array reference
2530
    $dbi->select(primary_key => ['id1', 'id2' ]);
2531

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

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

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

            
2539
    # Constant value
2540
    $dbi->select(where => 5);
2541

            
2542
    # Array reference
2543
    $dbi->select(where => [3, 5]);
2544

            
2545
In first examle, the following SQL is created.
2546

            
2547
    select * from book where id = ?
2548

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2551
=back
2552

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2565
=over 4
2566

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2569
Table name.
2570

            
2571
    $dbi->update(table => 'book');
2572

            
2573
=item C<param>
2574

            
2575
Update data. This is hash reference.
2576

            
2577
    $dbi->update(param => {title => 'Perl'});
2578

            
2579
=item C<where>
2580

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

            
2603
Append statement to last of SQL. This is string.
2604

            
2605
    $dbi->update(append => 'order by title');
2606

            
2607
=item C<filter>
2608

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

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

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

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

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

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

            
2645
You can check SQL.
2646

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2649
=back
2650

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2673
=over 4
2674

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

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

            
2682
    # Array reference
2683
    $dbi->update(primary_key => ['id1', 'id2' ]);
2684

            
2685
This is used to create where clause.
2686

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

            
2689
Where clause, created from primary key information.
2690
This is constant value or array reference.
2691

            
2692
    # Constant value
2693
    $dbi->update(where => 5);
2694

            
2695
    # Array reference
2696
    $dbi->update(where => [3, 5]);
2697

            
2698
In first examle, the following SQL is created.
2699

            
2700
    update book set title = ? where id = ?
2701

            
2702
Place holders are set to 'Perl' and 5.
2703

            
update pod
Yuki Kimoto authored on 2011-03-13
2704
=back
2705

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

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

            
2710
Create update parameter tag.
2711

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

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

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

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

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

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

            
2731
Create a new L<DBIx::Custom::Where> object.
2732

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2740
=head1 Tags
2741

            
2742
The following tags is available.
2743

            
2744
=head2 C<?>
2745

            
2746
Placeholder tag.
2747

            
2748
    {? NAME}    ->   ?
2749

            
2750
=head2 C<=>
2751

            
2752
Equal tag.
2753

            
2754
    {= NAME}    ->   NAME = ?
2755

            
2756
=head2 C<E<lt>E<gt>>
2757

            
2758
Not equal tag.
2759

            
2760
    {<> NAME}   ->   NAME <> ?
2761

            
2762
=head2 C<E<lt>>
2763

            
2764
Lower than tag
2765

            
2766
    {< NAME}    ->   NAME < ?
2767

            
2768
=head2 C<E<gt>>
2769

            
2770
Greater than tag
2771

            
2772
    {> NAME}    ->   NAME > ?
2773

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

            
2776
Greater than or equal tag
2777

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

            
2780
=head2 C<E<lt>=>
2781

            
2782
Lower than or equal tag
2783

            
2784
    {<= NAME}   ->   NAME <= ?
2785

            
2786
=head2 C<like>
2787

            
2788
Like tag
2789

            
2790
    {like NAME}   ->   NAME like ?
2791

            
2792
=head2 C<in>
2793

            
2794
In tag.
2795

            
2796
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2797

            
2798
=head2 C<insert_param>
2799

            
2800
Insert parameter tag.
2801

            
2802
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2803

            
2804
=head2 C<update_param>
2805

            
2806
Updata parameter tag.
2807

            
2808
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2809

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

            
2812
=head2 C<DBIX_CUSTOM_DEBUG>
2813

            
2814
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2815
executed SQL is printed to STDERR.
2816

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

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

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

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

            
2826
C<< <kimoto.yuki at gmail.com> >>
2827

            
2828
L<http://github.com/yuki-kimoto/DBIx-Custom>
2829

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2830
=head1 AUTHOR
2831

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

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

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

            
2838
This program is free software; you can redistribute it and/or modify it
2839
under the same terms as Perl itself.
2840

            
2841
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2842

            
2843