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

            
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
3
our $VERSION = '0.1682';
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

            
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
154

            
155
sub assign_tag {
156
    my ($self, $param) = @_;
157
    
158
    # Create set tag
159
    my @params;
160
    my $safety = $self->safety_character;
161
    my $q = $self->reserved_word_quote;
162
    foreach my $column (keys %$param) {
163
        croak qq{"$column" is not safety column name } . _subname
164
          unless $column =~ /^[$safety\.]+$/;
165
        my $column = "$q$column$q";
166
        $column =~ s/\./$q.$q/;
167
        push @params, "$column = {? $column}";
168
    }
169
    my $tag = join(', ', @params);
170
    
171
    return $tag;
172
}
173

            
cleanup
Yuki Kimoto authored on 2011-03-21
174
sub column {
175
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
176
    
cleanup
Yuki Kimoto authored on 2011-04-02
177
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
178
    my $q = $self->reserved_word_quote;
179
    
cleanup
Yuki Kimoto authored on 2011-04-02
180
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
181
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
182
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
183
    push @column, "$q$table$q.$q$_$q as $q${table}${q}__$q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
184
    
185
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
186
}
187

            
packaging one directory
yuki-kimoto authored on 2009-11-16
188
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
189
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
190
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
191
    # Connect
192
    $self->dbh;
update document
yuki-kimoto authored on 2010-01-30
193
    
cleanup
Yuki Kimoto authored on 2011-04-02
194
    # Set process ID
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
195
    $self->pid($$);
196
    
packaging one directory
yuki-kimoto authored on 2009-11-16
197
    return $self;
198
}
199

            
cleanup
yuki-kimoto authored on 2010-10-17
200
sub create_query {
201
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
202
    
cleanup
yuki-kimoto authored on 2010-10-17
203
    # Cache
204
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
205
    
cleanup
Yuki Kimoto authored on 2011-04-02
206
    # Query
cleanup
yuki-kimoto authored on 2010-10-17
207
    my $query;
cleanup
Yuki Kimoto authored on 2011-04-02
208
    
209
    # Get cached query
cleanup
yuki-kimoto authored on 2010-10-17
210
    if ($cache) {
211
        
212
        # Get query
213
        my $q = $self->cache_method->($self, $source);
214
        
215
        # Create query
add table tag
Yuki Kimoto authored on 2011-02-09
216
        if ($q) {
217
            $query = DBIx::Custom::Query->new($q);
218
            $query->filters($self->filters);
219
        }
cleanup
yuki-kimoto authored on 2010-10-17
220
    }
221
    
cleanup
Yuki Kimoto authored on 2011-04-02
222
    # Create query
cleanup
yuki-kimoto authored on 2010-10-17
223
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
224

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
234
        # Save query to cache
235
        $self->cache_method->(
236
            $self, $source,
237
            {
238
                sql     => $query->sql, 
239
                columns => $query->columns,
240
                tables  => $query->tables
241
            }
242
        ) if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
243
    }
244
    
cleanup
yuki-kimoto authored on 2010-10-17
245
    # Prepare statement handle
246
    my $sth;
247
    eval { $sth = $self->dbh->prepare($query->{sql})};
improved error messages
Yuki Kimoto authored on 2011-04-18
248
    
249
    if ($@) {
250
        $self->_croak($@, qq{. Following SQL is executed.\n}
cleanup
Yuki Kimoto authored on 2011-04-25
251
                        . qq{$query->{sql}\n} . _subname);
improved error messages
Yuki Kimoto authored on 2011-04-18
252
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
253
    
cleanup
yuki-kimoto authored on 2010-10-17
254
    # Set statement handle
255
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
256
    
cleanup
Yuki Kimoto authored on 2011-02-09
257
    # Set filters
258
    $query->filters($self->filters);
259
    
cleanup
yuki-kimoto authored on 2010-10-17
260
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
261
}
262

            
update pod
Yuki Kimoto authored on 2011-03-13
263
sub dbh {
264
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
265
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
266
    # Set
267
    if (@_) {
268
        $self->{dbh} = $_[0];
269
        
270
        return $self;
271
    }
272
    
273
    # Get
274
    else {
275
        # From Connction manager
276
        if (my $connector = $self->connector) {
cleanup
Yuki Kimoto authored on 2011-04-25
277
            croak "connector must have dbh() method " . _subname
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
278
              unless ref $connector && $connector->can('dbh');
279
              
280
            return $self->{dbh} = $connector->dbh;
281
        }
282
        
283
        return $self->{dbh} ||= $self->_connect;
update pod
Yuki Kimoto authored on 2011-03-13
284
    }
285
}
286

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
293
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
294
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
295
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
296
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
297
    }
298
    
299
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
300
    my $table = $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
301
    croak qq{"table" option must be specified. } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
302
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
303
    my $where            = delete $args{where} || {};
304
    my $append           = delete $args{append};
305
    my $allow_delete_all = delete $args{allow_delete_all};
cleanup
Yuki Kimoto authored on 2011-04-02
306
    my $query_return     = delete $args{query};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
307
    my $where_param      = delete $args{where_param} || {};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
308

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
309
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
310
    my $where_clause = '';
311
    if (ref $where) {
312
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
313
        $where_param = keys %$where_param
314
                     ? $self->merge_param($where_param, $where->param)
315
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
316
        
317
        # String where
318
        $where_clause = $where->to_string;
319
    }
320
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
321
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
322
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
323

            
cleanup
Yuki Kimoto authored on 2011-04-02
324
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
325
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
326
    my $q = $self->reserved_word_quote;
327
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
328
    push @sql, $append if $append;
329
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
330
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
331
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
332
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
333
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
334
    
packaging one directory
yuki-kimoto authored on 2009-11-16
335
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
336
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
337
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
338
        param => $where_param,
cleanup
Yuki Kimoto authored on 2011-03-21
339
        table => $table,
340
        %args
341
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
342
}
343

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

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

            
348
sub delete_at {
349
    my ($self, %args) = @_;
350
    
cleanup
Yuki Kimoto authored on 2011-04-02
351
    # Arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
352
    my $primary_keys = delete $args{primary_key};
353
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-04-02
354
    my $where = delete $args{where};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
355
    
cleanup
Yuki Kimoto authored on 2011-04-02
356
    # Check arguments
357
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
358
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
359
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
360
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
361
    
cleanup
Yuki Kimoto authored on 2011-04-02
362
    # Create where parameter
363
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
364
    
cleanup
Yuki Kimoto authored on 2011-04-02
365
    return $self->delete(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
366
}
367

            
added helper method
yuki-kimoto authored on 2010-10-17
368
sub DESTROY { }
369

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
370
sub create_model {
371
    my $self = shift;
372
    
cleanup
Yuki Kimoto authored on 2011-04-02
373
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
374
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
375
    $args->{dbi} = $self;
376
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
377
    my $model_name  = delete $args->{name};
378
    my $model_table = delete $args->{table};
379
    $model_name ||= $model_table;
380
    
cleanup
Yuki Kimoto authored on 2011-04-02
381
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
382
    my $model = $model_class->new($args);
383
    $model->name($model_name) unless $model->name;
384
    $model->table($model_table) unless $model->table;
385
    
386
    # Apply filter
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
387
    my $filter = ref $model->filter eq 'HASH'
388
               ? [%{$model->filter}]
389
               : $model->filter;
390
    $self->apply_filter($model->table, @$filter);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
391
    
cleanup
Yuki Kimoto authored on 2011-04-02
392
    # Associate table with model
cleanup
Yuki Kimoto authored on 2011-04-25
393
    croak "Table name is duplicated " . _subname
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
394
      if exists $self->{_model_from}->{$model->table};
395
    $self->{_model_from}->{$model->table} = $model->name;
396

            
397
    # Table alias
398
    $self->{_table_alias} ||= {};
399
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
400
    
401
    # Set model
402
    $self->model($model->name, $model);
403
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
404
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
405
}
406

            
407
sub each_column {
408
    my ($self, $cb) = @_;
409
    
410
    # Iterate all tables
411
    my $sth_tables = $self->dbh->table_info;
412
    while (my $table_info = $sth_tables->fetchrow_hashref) {
413
        
414
        # Table
415
        my $table = $table_info->{TABLE_NAME};
416
        
417
        # Iterate all columns
418
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
419
        while (my $column_info = $sth_columns->fetchrow_hashref) {
420
            my $column = $column_info->{COLUMN_NAME};
421
            $self->$cb($table, $column, $column_info);
422
        }
423
    }
424
}
425

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
569
sub insert {
570
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
571
    
cleanup
yuki-kimoto authored on 2010-10-17
572
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
573
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
574
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
575
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
576
    my $param  = delete $args{param} || {};
577
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
578
    my $query_return  = delete $args{query};
579

            
580
    # Check arguments
581
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
582
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
583
          unless $INSERT_ARGS{$name};
584
    }
585

            
586
    # Reserved word quote
587
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
588
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
589
    # Columns
590
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
591
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
592
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
593
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
594
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
595
          $column = "$q$column$q";
596
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
597
        push @columns, $column;
598
    }
cleanup
yuki-kimoto authored on 2010-10-17
599
    
cleanup
Yuki Kimoto authored on 2011-04-02
600
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
601
    my @sql;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
602
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
603
    push @sql, $append if $append;
604
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
605
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
606
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
607
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
608
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
609
    
packaging one directory
yuki-kimoto authored on 2009-11-16
610
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
611
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
612
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
613
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
614
        table => $table,
615
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
616
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
617
}
618

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

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

            
624
    # Arguments
625
    my $primary_keys = delete $args{primary_key};
626
    $primary_keys = [$primary_keys] unless ref $primary_keys;
627
    my $where = delete $args{where};
628
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
629
    
cleanup
Yuki Kimoto authored on 2011-04-02
630
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
631
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
632
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
633
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
634
    }
635
    
cleanup
Yuki Kimoto authored on 2011-04-02
636
    # Create where parameter
637
    my $where_param = $self->_create_where_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-04-02
638
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
639
    
640
    return $self->insert(param => $param, %args);
641
}
642

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
643
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
644
    my ($self, $param) = @_;
645
    
cleanup
Yuki Kimoto authored on 2011-04-02
646
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
647
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
648
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
649
    my @columns;
650
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
651
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
652
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
653
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
654
        $column = "$q$column$q";
655
        $column =~ s/\./$q.$q/;
656
        push @columns, $column;
657
        push @placeholders, "{? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
658
    }
659
    
cleanup
Yuki Kimoto authored on 2011-04-02
660
    return '(' . join(', ', @columns) . ') ' . 'values ' .
661
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
662
}
663

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
664
sub include_model {
665
    my ($self, $name_space, $model_infos) = @_;
666
    
cleanup
Yuki Kimoto authored on 2011-04-02
667
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
668
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
669
    
670
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
671
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
672

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
729
sub merge_param {
730
    my ($self, @params) = @_;
731
    
cleanup
Yuki Kimoto authored on 2011-04-02
732
    # Merge parameters
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
733
    my $merge = {};
734
    foreach my $param (@params) {
735
        foreach my $column (keys %$param) {
736
            my $param_is_array = ref $param->{$column} eq 'ARRAY' ? 1 : 0;
737
            
738
            if (exists $merge->{$column}) {
739
                $merge->{$column} = [$merge->{$column}]
740
                  unless ref $merge->{$column} eq 'ARRAY';
741
                push @{$merge->{$column}},
742
                  ref $param->{$column} ? @{$param->{$column}} : $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
743
            }
744
            else {
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
745
                $merge->{$column} = $param->{$column};
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
746
            }
747
        }
748
    }
749
    
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
750
    return $merge;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
751
}
752

            
cleanup
Yuki Kimoto authored on 2011-03-21
753
sub method {
754
    my $self = shift;
755
    
cleanup
Yuki Kimoto authored on 2011-04-02
756
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
757
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
758
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
759
    
760
    return $self;
761
}
762

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
763
sub model {
764
    my ($self, $name, $model) = @_;
765
    
cleanup
Yuki Kimoto authored on 2011-04-02
766
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
767
    if ($model) {
768
        $self->models->{$name} = $model;
769
        return $self;
770
    }
771
    
772
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
773
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
774
      unless $self->models->{$name};
775
    
cleanup
Yuki Kimoto authored on 2011-04-02
776
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
777
    return $self->models->{$name};
778
}
779

            
cleanup
Yuki Kimoto authored on 2011-03-21
780
sub mycolumn {
781
    my ($self, $table, $columns) = @_;
782
    
cleanup
Yuki Kimoto authored on 2011-04-02
783
    # Create column clause
784
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
785
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
786
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
787
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
788
    
789
    return join (', ', @column);
790
}
791

            
added dbi_options attribute
kimoto authored on 2010-12-20
792
sub new {
793
    my $self = shift->SUPER::new(@_);
794
    
cleanup
Yuki Kimoto authored on 2011-04-02
795
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
796
    my @attrs = keys %$self;
797
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-25
798
        croak qq{"$attr" is wrong name } . _subname
added dbi_options attribute
kimoto authored on 2010-12-20
799
          unless $self->can($attr);
800
    }
cleanup
Yuki Kimoto authored on 2011-04-02
801
    
802
    # Register tag
cleanup
Yuki Kimoto authored on 2011-01-25
803
    $self->register_tag(
804
        '?'     => \&DBIx::Custom::Tag::placeholder,
805
        '='     => \&DBIx::Custom::Tag::equal,
806
        '<>'    => \&DBIx::Custom::Tag::not_equal,
807
        '>'     => \&DBIx::Custom::Tag::greater_than,
808
        '<'     => \&DBIx::Custom::Tag::lower_than,
809
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
810
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
811
        'like'  => \&DBIx::Custom::Tag::like,
812
        'in'    => \&DBIx::Custom::Tag::in,
813
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
814
        'update_param' => \&DBIx::Custom::Tag::update_param
815
    );
added dbi_options attribute
kimoto authored on 2010-12-20
816
    
817
    return $self;
818
}
819

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

            
cleanup
yuki-kimoto authored on 2010-10-17
822
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
823
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
824
    
825
    # Register filter
826
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
827
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
828
    
cleanup
Yuki Kimoto authored on 2011-04-02
829
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
830
}
packaging one directory
yuki-kimoto authored on 2009-11-16
831

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

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

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
841
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
842
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
843
    my $tables = ref $table eq 'ARRAY' ? $table
844
               : defined $table ? [$table]
845
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
846
    my $columns   = delete $args{column};
847
    my $where     = delete $args{where} || {};
848
    my $append    = delete $args{append};
849
    my $join      = delete $args{join} || [];
cleanup
Yuki Kimoto authored on 2011-04-25
850
    croak qq{"join" must be array reference } . _subname
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
851
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
852
    my $relation = delete $args{relation};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
853
    my $param = delete $args{param} || {}; # DEPRECATED!
854
    warn "DEPRECATED select() param option. this is renamed to where_param"
855
      if keys %$param;
856
    my $where_param = delete $args{where_param} || $param || {};
cleanup
Yuki Kimoto authored on 2011-04-02
857
    my $query_return = $args{query};
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
858
    my $wrap = delete $args{wrap};
cleanup
Yuki Kimoto authored on 2011-04-02
859

            
860
    # Check arguments
861
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
862
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
863
          unless $SELECT_ARGS{$name};
864
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
865
    
cleanup
Yuki Kimoto authored on 2011-03-09
866
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
867
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
868
    
cleanup
Yuki Kimoto authored on 2011-04-02
869
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
870
    my @sql;
871
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
872
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
873
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
874
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
875
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
876
        foreach my $column (@$columns) {
cleanup
Yuki Kimoto authored on 2011-04-02
877
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
878
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
879
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
880
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
881
    }
882
    else { push @sql, '*' }
883
    
884
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
885
    push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-04-02
886
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-30
887
    if ($relation) {
888
        my $found = {};
889
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
890
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
891
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
892
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
893
    }
cleanup
Yuki Kimoto authored on 2011-03-30
894
    else {
895
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
896
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
897
    }
898
    pop @sql if ($sql[-1] || '') eq ',';
cleanup
Yuki Kimoto authored on 2011-04-25
899
    croak "Not found table name " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
900
      unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
901

            
cleanup
Yuki Kimoto authored on 2011-04-02
902
    # Add tables in parameter
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
903
    unshift @$tables,
904
            @{$self->_search_tables(join(' ', keys %$where_param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
905
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
906
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
907
    my $where_clause = '';
cleanup
Yuki Kimoto authored on 2011-04-25
908
    if (ref $where) {
909
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
910
        $where_param = keys %$where_param
911
                     ? $self->merge_param($where_param, $where->param)
912
                     : $where->param;
cleanup
Yuki Kimoto authored on 2011-04-25
913
        
914
        # String where
915
        $where_clause = $where->to_string;
916
    }
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
917
    elsif ($where) { $where_clause = "where $where" }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
918
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
919
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
920
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
921
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
922
    # Push join
923
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
924
    
cleanup
Yuki Kimoto authored on 2011-03-09
925
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
926
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
927
    
cleanup
Yuki Kimoto authored on 2011-03-08
928
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
929
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
930
    
cleanup
Yuki Kimoto authored on 2011-04-02
931
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
932
    push @sql, $append if $append;
933
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
934
    # Wrap
935
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
936
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
937
          unless ref $wrap eq 'ARRAY';
938
        unshift @sql, $wrap->[0];
939
        push @sql, $wrap->[1];
940
    }
941
    
cleanup
Yuki Kimoto authored on 2011-01-27
942
    # SQL
943
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
944
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
945
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
946
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
947
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
948
    
packaging one directory
yuki-kimoto authored on 2009-11-16
949
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
950
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
951
        $query,
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
952
        param => $where_param, 
cleanup
Yuki Kimoto authored on 2011-03-21
953
        table => $tables,
954
        %args
955
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
956
    
957
    return $result;
958
}
959

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

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

            
965
    # Arguments
966
    my $primary_keys = delete $args{primary_key};
967
    $primary_keys = [$primary_keys] unless ref $primary_keys;
968
    my $where = delete $args{where};
969
    my $param = delete $args{param};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
970
    
cleanup
Yuki Kimoto authored on 2011-04-02
971
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
972
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
973
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
974
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
975
    }
976
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
977
    # Table
cleanup
Yuki Kimoto authored on 2011-04-25
978
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
979
      unless $args{table};
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
980
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
981
    
cleanup
Yuki Kimoto authored on 2011-04-02
982
    # Create where parameter
983
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
984
    
cleanup
Yuki Kimoto authored on 2011-04-02
985
    return $self->select(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
986
}
987

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
988
sub setup_model {
989
    my $self = shift;
990
    
cleanup
Yuki Kimoto authored on 2011-04-02
991
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
992
    $self->each_column(
993
        sub {
994
            my ($self, $table, $column, $column_info) = @_;
995
            if (my $model = $self->models->{$table}) {
996
                push @{$model->columns}, $column;
997
            }
998
        }
999
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1000
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1001
}
1002

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1009
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1010
    my $table = delete $args{table} || '';
cleanup
Yuki Kimoto authored on 2011-04-25
1011
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
1012
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1013
    my $param            = delete $args{param} || {};
1014
    my $where            = delete $args{where} || {};
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1015
    my $where_param      = delete $args{where_param} || {};
cleanup
Yuki Kimoto authored on 2011-03-21
1016
    my $append           = delete $args{append} || '';
1017
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1018
    
cleanup
Yuki Kimoto authored on 2011-04-02
1019
    # Check argument names
1020
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1021
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1022
          unless $UPDATE_ARGS{$name};
1023
    }
1024
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1025
    # Columns
1026
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1027
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
1028
    my $q = $self->reserved_word_quote;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1029
    foreach my $column (keys %$param) {
cleanup
Yuki Kimoto authored on 2011-04-25
1030
        croak qq{"$column" is not safety column name } . _subname
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1031
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1032
          $column = "$q$column$q";
1033
          $column =~ s/\./$q.$q/;
1034
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1035
    }
1036
        
cleanup
yuki-kimoto authored on 2010-10-17
1037
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1038
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1039

            
1040
    # Where
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1041
    my $where_clause = '';
1042
    if (ref $where) {
1043
        $where = $self->_where_to_obj($where);
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1044
        $where_param = keys %$where_param
1045
                     ? $self->merge_param($where_param, $where->param)
1046
                     : $where->param;
select, update, and delete w...
Yuki Kimoto authored on 2011-04-25
1047
        
1048
        # String where
1049
        $where_clause = $where->to_string;
1050
    }
1051
    elsif ($where) { $where_clause = "where $where" }
cleanup
Yuki Kimoto authored on 2011-04-25
1052
    croak qq{"where" must be specified } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
1053
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1054
    
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
1055
    # Merge param
1056
    $param = $self->merge_param($param, $where_param) if keys %$where_param;
1057
    
cleanup
Yuki Kimoto authored on 2011-04-02
1058
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1059
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
1060
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1061
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1062
    
cleanup
Yuki Kimoto authored on 2011-01-27
1063
    # SQL
1064
    my $sql = join(' ', @sql);
1065
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1066
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1067
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1068
    return $query if $args{query};
1069
    
cleanup
yuki-kimoto authored on 2010-10-17
1070
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1071
    my $ret_val = $self->execute(
1072
        $query,
1073
        param  => $param, 
1074
        table => $table,
1075
        %args
1076
    );
cleanup
yuki-kimoto authored on 2010-10-17
1077
    
1078
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1079
}
1080

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

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

            
1085
sub update_at {
1086
    my ($self, %args) = @_;
1087
    
cleanup
Yuki Kimoto authored on 2011-04-02
1088
    # Arguments
1089
    my $primary_keys = delete $args{primary_key};
1090
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1091
    my $where = delete $args{where};
1092
    
1093

            
1094
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1095
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1096
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
1097
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1098
    }
1099
    
cleanup
Yuki Kimoto authored on 2011-04-02
1100
    # Create where parameter
1101
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1102
    
cleanup
Yuki Kimoto authored on 2011-04-02
1103
    return $self->update(where => $where_param, %args);
1104
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1105

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1106
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1107
    my ($self, $param, $opt) = @_;
1108
    
cleanup
Yuki Kimoto authored on 2011-04-02
1109
    # Create update parameter tag
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1110
    my $tag = $self->assign_tag($param);
1111
    $tag = "set $tag" unless $opt->{no_set};
1112

            
cleanup
Yuki Kimoto authored on 2011-04-02
1113
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1114
}
1115

            
cleanup
Yuki Kimoto authored on 2011-01-25
1116
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1117
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1118
    
1119
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1120
    return DBIx::Custom::Where->new(
1121
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1122
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1123
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1124
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1125
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1126
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1127

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

            
improved error messages
Yuki Kimoto authored on 2011-04-18
1173
sub _create_where_param {
1174
    my ($self, $where, $primary_keys) = @_;
1175
    
1176
    # Create where parameter
1177
    my $where_param = {};
1178
    if ($where) {
1179
        $where = [$where] unless ref $where;
1180
        croak qq{"where" must be constant value or array reference}
1181
            . " (" . (caller 1)[3] . ")"
1182
          unless !ref $where || ref $where eq 'ARRAY';
1183
        
1184
        croak qq{"where" must contain values same count as primary key}
1185
            . " (" . (caller 1)[3] . ")"
1186
          unless @$primary_keys eq @$where;
1187
        
1188
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1189
           $where_param->{$primary_keys->[$i]} = $where->[$i];
1190
        }
1191
    }
1192
    
1193
    return $where_param;
1194
}
1195

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1196
sub _connect {
1197
    my $self = shift;
1198
    
1199
    # Attributes
1200
    my $data_source = $self->data_source;
cleanup
Yuki Kimoto authored on 2011-04-25
1201
    croak qq{"data_source" must be specified } . _subname
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1202
      unless $data_source;
1203
    my $user        = $self->user;
1204
    my $password    = $self->password;
1205
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1206
    
1207
    # Connect
1208
    my $dbh = eval {DBI->connect(
1209
        $data_source,
1210
        $user,
1211
        $password,
1212
        {
1213
            %{$self->default_dbi_option},
1214
            %$dbi_option
1215
        }
1216
    )};
1217
    
1218
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1219
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1220
    
1221
    return $dbh;
1222
}
1223

            
cleanup
yuki-kimoto authored on 2010-10-17
1224
sub _croak {
1225
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1226
    
1227
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1228
    $append ||= "";
1229
    
1230
    # Verbose
1231
    if ($Carp::Verbose) { croak $error }
1232
    
1233
    # Not verbose
1234
    else {
1235
        
1236
        # Remove line and module infromation
1237
        my $at_pos = rindex($error, ' at ');
1238
        $error = substr($error, 0, $at_pos);
1239
        $error =~ s/\s+$//;
1240
        croak "$error$append";
1241
    }
1242
}
1243

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1244
sub _need_tables {
1245
    my ($self, $tree, $need_tables, $tables) = @_;
1246
    
cleanup
Yuki Kimoto authored on 2011-04-02
1247
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1248
    foreach my $table (@$tables) {
1249
        if ($tree->{$table}) {
1250
            $need_tables->{$table} = 1;
1251
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1252
        }
1253
    }
1254
}
1255

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1297
sub _remove_duplicate_table {
1298
    my ($self, $tables, $main_table) = @_;
1299
    
1300
    # Remove duplicate table
1301
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1302
    delete $tables{$main_table} if $main_table;
1303
    
1304
    return [keys %tables, $main_table ? $main_table : ()];
1305
}
1306

            
cleanup
Yuki Kimoto authored on 2011-04-02
1307
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1308
    my ($self, $source) = @_;
1309
    
cleanup
Yuki Kimoto authored on 2011-04-02
1310
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1311
    my $tables = [];
1312
    my $safety_character = $self->safety_character;
1313
    my $q = $self->reserved_word_quote;
1314
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1315
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1316
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1317
    while ($source =~ /$table_re/g) {
1318
        push @$tables, $1;
1319
    }
1320
    
1321
    return $tables;
1322
}
1323

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1366
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1367
__PACKAGE__->attr(
1368
    dbi_options => sub { {} },
1369
    filter_check  => 1
1370
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1371

            
cleanup
Yuki Kimoto authored on 2011-01-25
1372
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1373
sub default_bind_filter {
1374
    my $self = shift;
1375
    
1376
    if (@_) {
1377
        my $fname = $_[0];
1378
        
1379
        if (@_ && !$fname) {
1380
            $self->{default_out_filter} = undef;
1381
        }
1382
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1383
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1384
              unless exists $self->filters->{$fname};
1385
        
1386
            $self->{default_out_filter} = $self->filters->{$fname};
1387
        }
1388
        return $self;
1389
    }
1390
    
1391
    return $self->{default_out_filter};
1392
}
1393

            
cleanup
Yuki Kimoto authored on 2011-01-25
1394
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1395
sub default_fetch_filter {
1396
    my $self = shift;
1397
    
1398
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1399
        my $fname = $_[0];
1400

            
cleanup
Yuki Kimoto authored on 2011-01-12
1401
        if (@_ && !$fname) {
1402
            $self->{default_in_filter} = undef;
1403
        }
1404
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1405
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1406
              unless exists $self->filters->{$fname};
1407
        
1408
            $self->{default_in_filter} = $self->filters->{$fname};
1409
        }
1410
        
1411
        return $self;
1412
    }
1413
    
many changed
Yuki Kimoto authored on 2011-01-23
1414
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1415
}
1416

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1417
# DEPRECATED!
1418
sub insert_param {
1419
    warn "insert_param is renamed to insert_param_tag."
1420
       . " insert_param is DEPRECATED!";
1421
    return shift->insert_param_tag(@_);
1422
}
1423

            
cleanup
Yuki Kimoto authored on 2011-01-25
1424
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1425
sub register_tag_processor {
1426
    return shift->query_builder->register_tag_processor(@_);
1427
}
1428

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1429
# DEPRECATED!
1430
sub update_param {
1431
    warn "update_param is renamed to update_param_tag."
1432
       . " update_param is DEPRECATED!";
1433
    return shift->update_param_tag(@_);
1434
}
cleanup
Yuki Kimoto authored on 2011-03-08
1435
# DEPRECATED!
1436
sub _push_relation {
1437
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1438
    
1439
    if (keys %{$relation || {}}) {
1440
        push @$sql, $need_where ? 'where' : 'and';
1441
        foreach my $rcolumn (keys %$relation) {
1442
            my $table1 = (split (/\./, $rcolumn))[0];
1443
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1444
            push @$tables, ($table1, $table2);
1445
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1446
        }
1447
    }
1448
    pop @$sql if $sql->[-1] eq 'and';    
1449
}
1450

            
1451
# DEPRECATED!
1452
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1453
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1454
    
1455
    if (keys %{$relation || {}}) {
1456
        foreach my $rcolumn (keys %$relation) {
1457
            my $table1 = (split (/\./, $rcolumn))[0];
1458
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1459
            my $table1_exists;
1460
            my $table2_exists;
1461
            foreach my $table (@$tables) {
1462
                $table1_exists = 1 if $table eq $table1;
1463
                $table2_exists = 1 if $table eq $table2;
1464
            }
1465
            unshift @$tables, $table1 unless $table1_exists;
1466
            unshift @$tables, $table2 unless $table2_exists;
1467
        }
1468
    }
1469
}
1470

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1473
=head1 NAME
1474

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

            
1477
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1478

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1479
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1480
    
1481
    # Connect
1482
    my $dbi = DBIx::Custom->connect(
1483
        data_source => "dbi:mysql:database=dbname",
1484
        user => 'ken',
1485
        password => '!LFKD%$&',
1486
        dbi_option => {mysql_enable_utf8 => 1}
1487
    );
cleanup
yuki-kimoto authored on 2010-08-05
1488

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1489
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1490
    $dbi->insert(
1491
        table  => 'book',
1492
        param  => {title => 'Perl', author => 'Ken'}
1493
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1494
    
1495
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1496
    $dbi->update(
1497
        table  => 'book', 
1498
        param  => {title => 'Perl', author => 'Ken'}, 
1499
        where  => {id => 5},
1500
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1501
    
1502
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1503
    $dbi->delete(
1504
        table  => 'book',
1505
        where  => {author => 'Ken'},
1506
    );
cleanup
yuki-kimoto authored on 2010-08-05
1507

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

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

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

            
1546
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1547

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1552
There are many basic methods to execute various queries.
1553
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1554
C<delete_all()>, C<select()>,
1555
C<insert_at()>, C<update_at()>, 
1556
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1557

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1558
=item *
1559

            
1560
Filter when data is send or receive.
1561

            
1562
=item *
1563

            
1564
Data filtering system
1565

            
1566
=item *
1567

            
1568
Model support.
1569

            
1570
=item *
1571

            
1572
Generate where clause dinamically.
1573

            
1574
=item *
1575

            
1576
Generate join clause dinamically.
1577

            
1578
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1579

            
1580
=head1 GUIDE
1581

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

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

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

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

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

            
1592
    my $connector = $dbi->connector;
1593
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1594

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

            
1598
This is L<DBIx::Connector> example. Please pass
1599
C<default_dbi_option> to L<DBIx::Connector>.
1600

            
1601
    my $connector = DBIx::Connector->new(
1602
        "dbi:mysql:database=$DATABASE",
1603
        $USER,
1604
        $PASSWORD,
1605
        DBIx::Custom->new->default_dbi_option
1606
    );
1607
    
1608
    my $dbi = DBIx::Custom->new(connector => $connector);
1609

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

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

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

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

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

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

            
1625
=head2 C<default_dbi_option>
1626

            
1627
    my $default_dbi_option = $dbi->default_dbi_option;
1628
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1629

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1633
    {
1634
        RaiseError => 1,
1635
        PrintError => 0,
1636
        AutoCommit => 1,
1637
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1638

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

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

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

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

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

            
1651
    my $models = $dbi->models;
1652
    $dbi       = $dbi->models(\%models);
1653

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1656
=head2 C<password>
1657

            
1658
    my $password = $dbi->password;
1659
    $dbi         = $dbi->password('lkj&le`@s');
1660

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

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

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

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

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

            
1672
     my reserved_word_quote = $dbi->reserved_word_quote;
1673
     $dbi                   = $dbi->reserved_word_quote('"');
1674

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1694
    my $user = $dbi->user;
1695
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1696

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1707
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1708
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1709
        'issue_date' => {
1710
            out => 'tp_to_date',
1711
            in  => 'date_to_tp',
1712
            end => 'tp_to_displaydate'
1713
        },
1714
        'write_date' => {
1715
            out => 'tp_to_date',
1716
            in  => 'date_to_tp',
1717
            end => 'tp_to_displaydate'
1718
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1719
    );
1720

            
update pod
Yuki Kimoto authored on 2011-03-13
1721
Apply filter to columns.
1722
C<out> filter is executed before data is send to database.
1723
C<in> filter is executed after a row is fetch.
1724
C<end> filter is execute after C<in> filter is executed.
1725

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1728
       PETTERN         EXAMPLE
1729
    1. Column        : author
1730
    2. Table.Column  : book.author
1731
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1732

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

            
1736
You can set multiple filters at once.
1737

            
1738
    $dbi->apply_filter(
1739
        'book',
1740
        [qw/issue_date write_date/] => {
1741
            out => 'tp_to_date',
1742
            in  => 'date_to_tp',
1743
            end => 'tp_to_displaydate'
1744
        }
1745
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1746

            
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1747
=head2 C<assign_tag> EXPERIMENTAL
1748

            
1749
    my $assign_tag = $dbi->assign_tag({title => 'a', age => 2});
1750

            
1751
Create assign tag.
1752

            
1753
    title = {? title}, author = {? author}
1754

            
1755
This is equal to C<update_param_tag> exept that set is not added.
1756

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1759
    my $dbi = DBIx::Custom->connect(
1760
        data_source => "dbi:mysql:database=dbname",
1761
        user => 'ken',
1762
        password => '!LFKD%$&',
1763
        dbi_option => {mysql_enable_utf8 => 1}
1764
    );
1765

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1774
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1775
        table => 'book',
1776
        primary_key => 'id',
1777
        join => [
1778
            'inner join company on book.comparny_id = company.id'
1779
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1780
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1781
            publish_date => {
1782
                out => 'tp_to_date',
1783
                in => 'date_to_tp',
1784
                end => 'tp_to_displaydate'
1785
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1786
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1787
    );
1788

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

            
1792
   $dbi->model('book')->select(...);
1793

            
cleanup
yuki-kimoto authored on 2010-10-17
1794
=head2 C<create_query>
1795
    
1796
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1797
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1798
    );
update document
yuki-kimoto authored on 2009-11-19
1799

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

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

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

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

            
1810
    my $dbh = $dbi->dbh;
1811

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

            
1815
=head2 C<each_column>
1816

            
1817
    $dbi->each_column(
1818
        sub {
1819
            my ($dbi, $table, $column, $column_info) = @_;
1820
            
1821
            my $type = $column_info->{TYPE_NAME};
1822
            
1823
            if ($type eq 'DATE') {
1824
                # ...
1825
            }
1826
        }
1827
    );
1828

            
1829
Iterate all column informations of all table from database.
1830
Argument is callback when one column is found.
1831
Callback receive four arguments, dbi object, table name,
1832
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1833

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1836
    my $result = $dbi->execute(
1837
        "select * from book where {= title} and {like author}",
1838
        param => {title => 'Perl', author => '%Ken%'}
1839
    );
1840

            
1841
Execute SQL, containing tags.
1842
Return value is L<DBIx::Custom::Result> in select statement, or
1843
the count of affected rows in insert, update, delete statement.
1844

            
1845
Tag is turned into the statement containing place holder
1846
before SQL is executed.
1847

            
1848
    select * from where title = ? and author like ?;
1849

            
1850
See also L<Tags/Tags>.
1851

            
1852
The following opitons are currently available.
1853

            
1854
=over 4
1855

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

            
1858
Table names for filtering.
1859

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

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

            
1865

            
1866

            
1867

            
1868

            
1869

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

            
1872
Filter, executed before data is send to database. This is array reference.
1873
Filter value is code reference or
1874
filter name registerd by C<register_filter()>.
1875

            
1876
    # Basic
1877
    $dbi->execute(
1878
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1879
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1880
            title  => sub { uc $_[0] }
1881
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1882
        }
update pod
Yuki Kimoto authored on 2011-03-13
1883
    );
1884
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1885
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1886
    $dbi->execute(
1887
        $sql,
1888
        filter => [
1889
            [qw/title author/]  => sub { uc $_[0] }
1890
        ]
1891
    );
1892
    
1893
    # Filter name
1894
    $dbi->execute(
1895
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1896
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1897
            title  => 'upper_case',
1898
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1899
        }
update pod
Yuki Kimoto authored on 2011-03-13
1900
    );
1901

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

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

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

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

            
1910
Delete statement.
1911

            
1912
The following opitons are currently available.
1913

            
update pod
Yuki Kimoto authored on 2011-03-13
1914
=over 4
1915

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

            
1918
Table name.
1919

            
1920
    $dbi->delete(table => 'book');
1921

            
1922
=item C<where>
1923

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1924
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1925
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1926
    
1927
    # Hash reference
1928
    $dbi->delete(where => {title => 'Perl'});
1929
    
1930
    # DBIx::Custom::Where object
1931
    my $where = $dbi->where(
1932
        clause => ['and', '{= author}', '{like title}'],
1933
        param  => {author => 'Ken', title => '%Perl%'}
1934
    );
1935
    $dbi->delete(where => $where);
1936

            
updated pod
Yuki Kimoto authored on 2011-04-25
1937
    # String(with where_param option)
1938
    $dbi->delete(
1939
        where => '{like title}',
1940
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1941
    );
1942
    
update pod
Yuki Kimoto authored on 2011-03-13
1943
=item C<append>
1944

            
1945
Append statement to last of SQL. This is string.
1946

            
1947
    $dbi->delete(append => 'order by title');
1948

            
1949
=item C<filter>
1950

            
1951
Filter, executed before data is send to database. This is array reference.
1952
Filter value is code reference or
1953
filter name registerd by C<register_filter()>.
1954

            
1955
    # Basic
1956
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1957
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1958
            title  => sub { uc $_[0] }
1959
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1960
        }
update pod
Yuki Kimoto authored on 2011-03-13
1961
    );
1962
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1963
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1964
    $dbi->delete(
1965
        filter => [
1966
            [qw/title author/]  => sub { uc $_[0] }
1967
        ]
1968
    );
1969
    
1970
    # Filter name
1971
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1972
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1973
            title  => 'upper_case',
1974
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1975
        }
update pod
Yuki Kimoto authored on 2011-03-13
1976
    );
1977

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

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

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

            
1984
Create column clause. The follwoing column clause is created.
1985

            
1986
    book.author as book__author,
1987
    book.title as book__title
1988

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

            
1991
Get L<DBIx::Custom::Query> object instead of executing SQL.
1992
This is true or false value.
1993

            
1994
    my $query = $dbi->delete(query => 1);
1995

            
1996
You can check SQL.
1997

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2000
=back
2001

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

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

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

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

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

            
2013
    $dbi->delete_at(
2014
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2015
        primary_key => 'id',
2016
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2017
    );
2018

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2027
Primary key. This is constant value or array reference.
2028
    
2029
    # Constant value
2030
    $dbi->delete(primary_key => 'id');
2031

            
2032
    # Array reference
2033
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2034

            
2035
This is used to create where clause.
2036

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

            
2039
Where clause, created from primary key information.
2040
This is constant value or array reference.
2041

            
2042
    # Constant value
2043
    $dbi->delete(where => 5);
2044

            
2045
    # Array reference
2046
    $dbi->delete(where => [3, 5]);
2047

            
2048
In first examle, the following SQL is created.
2049

            
2050
    delete from book where id = ?;
2051

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2054
=back
2055

            
cleanup
yuki-kimoto authored on 2010-10-17
2056
=head2 C<insert>
2057

            
update pod
Yuki Kimoto authored on 2011-03-13
2058
    $dbi->insert(
2059
        table  => 'book', 
2060
        param  => {title => 'Perl', author => 'Ken'}
2061
    );
2062

            
2063
Insert statement.
2064

            
2065
The following opitons are currently available.
2066

            
update pod
Yuki Kimoto authored on 2011-03-13
2067
=over 4
2068

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

            
2071
Table name.
2072

            
2073
    $dbi->insert(table => 'book');
2074

            
2075
=item C<param>
2076

            
2077
Insert data. This is hash reference.
2078

            
2079
    $dbi->insert(param => {title => 'Perl'});
2080

            
2081
=item C<append>
2082

            
2083
Append statement to last of SQL. This is string.
2084

            
2085
    $dbi->insert(append => 'order by title');
2086

            
2087
=item C<filter>
2088

            
2089
Filter, executed before data is send to database. This is array reference.
2090
Filter value is code reference or
2091
filter name registerd by C<register_filter()>.
2092

            
2093
    # Basic
2094
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2095
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2096
            title  => sub { uc $_[0] }
2097
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2098
        }
update pod
Yuki Kimoto authored on 2011-03-13
2099
    );
2100
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2101
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2102
    $dbi->insert(
2103
        filter => [
2104
            [qw/title author/]  => sub { uc $_[0] }
2105
        ]
2106
    );
2107
    
2108
    # Filter name
2109
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2110
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2111
            title  => 'upper_case',
2112
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2113
        }
update pod
Yuki Kimoto authored on 2011-03-13
2114
    );
2115

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

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

            
2120
Get L<DBIx::Custom::Query> object instead of executing SQL.
2121
This is true or false value.
2122

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2129
=back
2130

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

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

            
2135
    $dbi->insert_at(
2136
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2137
        primary_key => 'id',
2138
        where => '5',
2139
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2140
    );
2141

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

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

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

            
2150
Primary key. This is constant value or array reference.
2151
    
2152
    # Constant value
2153
    $dbi->insert(primary_key => 'id');
2154

            
2155
    # Array reference
2156
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2157

            
2158
This is used to create parts of insert data.
2159

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

            
2162
Parts of Insert data, create from primary key information.
2163
This is constant value or array reference.
2164

            
2165
    # Constant value
2166
    $dbi->insert(where => 5);
2167

            
2168
    # Array reference
2169
    $dbi->insert(where => [3, 5]);
2170

            
2171
In first examle, the following SQL is created.
2172

            
2173
    insert into book (id, title) values (?, ?);
2174

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2177
=back
2178

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

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

            
2183
Create insert parameter tag.
2184

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2194
    lib / MyModel.pm
2195
        / MyModel / book.pm
2196
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2197

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

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

            
2202
    package MyModel;
2203
    
2204
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2205
    
2206
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2207

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2212
    package MyModel::book;
2213
    
2214
    use base 'MyModel';
2215
    
2216
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2217

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2220
    package MyModel::company;
2221
    
2222
    use base 'MyModel';
2223
    
2224
    1;
2225
    
2226
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2227

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

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

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

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

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

            
2239
Merge paramters.
2240

            
2241
$param:
2242

            
2243
    {key1 => [1, 1], key2 => 2}
2244

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

            
2247
    $dbi->method(
2248
        update_or_insert => sub {
2249
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2250
            
2251
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2252
        },
2253
        find_or_create   => sub {
2254
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2255
            
2256
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2257
        }
2258
    );
2259

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

            
2262
    $dbi->update_or_insert;
2263
    $dbi->find_or_create;
2264

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

            
2267
    $dbi->model('book')->method(
2268
        insert => sub { ... },
2269
        update => sub { ... }
2270
    );
2271
    
2272
    my $model = $dbi->model('book');
2273

            
2274
Set and get a L<DBIx::Custom::Model> object,
2275

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

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

            
2280
Create column clause for myself. The follwoing column clause is created.
2281

            
2282
    book.author as author,
2283
    book.title as title
2284

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2287
    my $dbi = DBIx::Custom->new(
2288
        data_source => "dbi:mysql:database=dbname",
2289
        user => 'ken',
2290
        password => '!LFKD%$&',
2291
        dbi_option => {mysql_enable_utf8 => 1}
2292
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2293

            
2294
Create a new L<DBIx::Custom> object.
2295

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

            
2298
    my $not_exists = $dbi->not_exists;
2299

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2303
=head2 C<register_filter>
2304

            
update pod
Yuki Kimoto authored on 2011-03-13
2305
    $dbi->register_filter(
2306
        # Time::Piece object to database DATE format
2307
        tp_to_date => sub {
2308
            my $tp = shift;
2309
            return $tp->strftime('%Y-%m-%d');
2310
        },
2311
        # database DATE format to Time::Piece object
2312
        date_to_tp => sub {
2313
           my $date = shift;
2314
           return Time::Piece->strptime($date, '%Y-%m-%d');
2315
        }
2316
    );
cleanup
yuki-kimoto authored on 2010-10-17
2317
    
update pod
Yuki Kimoto authored on 2011-03-13
2318
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2319

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2322
    $dbi->register_tag(
2323
        update => sub {
2324
            my @columns = @_;
2325
            
2326
            # Update parameters
2327
            my $s = 'set ';
2328
            $s .= "$_ = ?, " for @columns;
2329
            $s =~ s/, $//;
2330
            
2331
            return [$s, \@columns];
2332
        }
2333
    );
cleanup
yuki-kimoto authored on 2010-10-17
2334

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2358
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2359
        table  => 'book',
2360
        column => ['author', 'title'],
2361
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2362
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2363
    
update pod
Yuki Kimoto authored on 2011-03-12
2364
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2365

            
2366
The following opitons are currently available.
2367

            
2368
=over 4
2369

            
2370
=item C<table>
2371

            
2372
Table name.
2373

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

            
2376
=item C<column>
2377

            
2378
Column clause. This is array reference or constant value.
2379

            
2380
    # Hash refernce
2381
    $dbi->select(column => ['author', 'title']);
2382
    
2383
    # Constant value
2384
    $dbi->select(column => 'author');
2385

            
2386
Default is '*' unless C<column> is specified.
2387

            
2388
    # Default
2389
    $dbi->select(column => '*');
2390

            
2391
=item C<where>
2392

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2393
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2394
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2395
    
2396
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2397
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2398
    
update pod
Yuki Kimoto authored on 2011-03-12
2399
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2400
    my $where = $dbi->where(
2401
        clause => ['and', '{= author}', '{like title}'],
2402
        param  => {author => 'Ken', title => '%Perl%'}
2403
    );
update pod
Yuki Kimoto authored on 2011-03-12
2404
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2405

            
updated pod
Yuki Kimoto authored on 2011-04-25
2406
    # String(with where_param option)
2407
    $dbi->select(
2408
        where => '{like title}',
2409
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2410
    );
2411
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2412
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2413

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

            
2416
    $dbi->select(join =>
2417
        [
2418
            'left outer join company on book.company_id = company_id',
2419
            'left outer join location on company.location_id = location.id'
2420
        ]
2421
    );
2422

            
2423
If column cluase or where clause contain table name like "company.name",
2424
needed join clause is used automatically.
2425

            
2426
    $dbi->select(
2427
        table => 'book',
2428
        column => ['company.location_id as company__location_id'],
2429
        where => {'company.name' => 'Orange'},
2430
        join => [
2431
            'left outer join company on book.company_id = company.id',
2432
            'left outer join location on company.location_id = location.id'
2433
        ]
2434
    );
2435

            
2436
In above select, the following SQL is created.
2437

            
2438
    select company.location_id as company__location_id
2439
    from book
2440
      left outer join company on book.company_id = company.id
2441
    where company.name = Orange
2442

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

            
2445
Parameter shown before where clause.
2446
    
2447
    $dbi->select(
2448
        table => 'table1',
2449
        column => 'table1.key1 as table1_key1, key2, key3',
2450
        where   => {'table1.key2' => 3},
2451
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2452
                  ' as table2 on table1.key1 = table2.key1'],
2453
        param => {'table2.key3' => 5}
2454
    );
2455

            
2456
For example, if you want to contain tag in join clause, 
2457
you can pass parameter by C<param> option.
2458

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

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

            
2463
    $dbi->select(append => 'order by title');
2464

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

            
2467
Wrap statement. This is array reference.
2468

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

            
2471
This option is for Oracle and SQL Server paging process.
2472

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

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

            
2479
    # Basic
2480
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2481
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2482
            title  => sub { uc $_[0] }
2483
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2484
        }
update pod
Yuki Kimoto authored on 2011-03-12
2485
    );
2486
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2487
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2488
    $dbi->select(
2489
        filter => [
2490
            [qw/title author/]  => sub { uc $_[0] }
2491
        ]
2492
    );
2493
    
2494
    # Filter name
2495
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2496
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2497
            title  => 'upper_case',
2498
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2499
        }
update pod
Yuki Kimoto authored on 2011-03-12
2500
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2501

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

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

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

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

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

            
2513
    my $sql = $query->sql;
2514

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

            
2517
Specify database data type.
2518

            
2519
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2520
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2521

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

            
2524
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2525

            
update pod
Yuki Kimoto authored on 2011-03-12
2526
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2527

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

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

            
2532
    $dbi->select_at(
2533
        table => 'book',
2534
        primary_key => 'id',
2535
        where => '5'
2536
    );
2537

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2542
=over 4
2543

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2546
Primary key. This is constant value or array reference.
2547
    
2548
    # Constant value
2549
    $dbi->select(primary_key => 'id');
2550

            
2551
    # Array reference
2552
    $dbi->select(primary_key => ['id1', 'id2' ]);
2553

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

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

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

            
2561
    # Constant value
2562
    $dbi->select(where => 5);
2563

            
2564
    # Array reference
2565
    $dbi->select(where => [3, 5]);
2566

            
2567
In first examle, the following SQL is created.
2568

            
2569
    select * from book where id = ?
2570

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2573
=back
2574

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2577
    $dbi->update(
2578
        table  => 'book',
2579
        param  => {title => 'Perl'},
2580
        where  => {id => 4}
2581
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2582

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2587
=over 4
2588

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2591
Table name.
2592

            
2593
    $dbi->update(table => 'book');
2594

            
2595
=item C<param>
2596

            
2597
Update data. This is hash reference.
2598

            
2599
    $dbi->update(param => {title => 'Perl'});
2600

            
2601
=item C<where>
2602

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2603
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2604
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2605
    
2606
    # Hash reference
2607
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2608
    
2609
    # DBIx::Custom::Where object
2610
    my $where = $dbi->where(
2611
        clause => ['and', '{= author}', '{like title}'],
2612
        param  => {author => 'Ken', title => '%Perl%'}
2613
    );
2614
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2615
    
updated pod
Yuki Kimoto authored on 2011-04-25
2616
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2617
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2618
        param => {title => 'Perl'},
2619
        where => '{= id}',
2620
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2621
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2622
    
update pod
Yuki Kimoto authored on 2011-03-13
2623
=item C<append>
2624

            
2625
Append statement to last of SQL. This is string.
2626

            
2627
    $dbi->update(append => 'order by title');
2628

            
2629
=item C<filter>
2630

            
2631
Filter, executed before data is send to database. This is array reference.
2632
Filter value is code reference or
2633
filter name registerd by C<register_filter()>.
2634

            
2635
    # Basic
2636
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2637
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2638
            title  => sub { uc $_[0] }
2639
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2640
        }
update pod
Yuki Kimoto authored on 2011-03-13
2641
    );
2642
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2643
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2644
    $dbi->update(
2645
        filter => [
2646
            [qw/title author/]  => sub { uc $_[0] }
2647
        ]
2648
    );
2649
    
2650
    # Filter name
2651
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2652
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2653
            title  => 'upper_case',
2654
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2655
        }
update pod
Yuki Kimoto authored on 2011-03-13
2656
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2657

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

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

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

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

            
2667
You can check SQL.
2668

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2671
=back
2672

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

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

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

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

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

            
2684
    $dbi->update_at(
2685
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2686
        primary_key => 'id',
2687
        where => '5',
2688
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2689
    );
2690

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2695
=over 4
2696

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

            
2699
Primary key. This is constant value or array reference.
2700
    
2701
    # Constant value
2702
    $dbi->update(primary_key => 'id');
2703

            
2704
    # Array reference
2705
    $dbi->update(primary_key => ['id1', 'id2' ]);
2706

            
2707
This is used to create where clause.
2708

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

            
2711
Where clause, created from primary key information.
2712
This is constant value or array reference.
2713

            
2714
    # Constant value
2715
    $dbi->update(where => 5);
2716

            
2717
    # Array reference
2718
    $dbi->update(where => [3, 5]);
2719

            
2720
In first examle, the following SQL is created.
2721

            
2722
    update book set title = ? where id = ?
2723

            
2724
Place holders are set to 'Perl' and 5.
2725

            
update pod
Yuki Kimoto authored on 2011-03-13
2726
=back
2727

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

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

            
2732
Create update parameter tag.
2733

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2739
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2740
        {title => 'a', age => 2}
2741
        {no_set => 1}
2742
    );
2743

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2748
    my $where = $dbi->where(
2749
        clause => ['and', '{= title}', '{= author}'],
2750
        param => {title => 'Perl', author => 'Ken'}
2751
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2752

            
2753
Create a new L<DBIx::Custom::Where> object.
2754

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2762
=head1 Tags
2763

            
2764
The following tags is available.
2765

            
2766
=head2 C<?>
2767

            
2768
Placeholder tag.
2769

            
2770
    {? NAME}    ->   ?
2771

            
2772
=head2 C<=>
2773

            
2774
Equal tag.
2775

            
2776
    {= NAME}    ->   NAME = ?
2777

            
2778
=head2 C<E<lt>E<gt>>
2779

            
2780
Not equal tag.
2781

            
2782
    {<> NAME}   ->   NAME <> ?
2783

            
2784
=head2 C<E<lt>>
2785

            
2786
Lower than tag
2787

            
2788
    {< NAME}    ->   NAME < ?
2789

            
2790
=head2 C<E<gt>>
2791

            
2792
Greater than tag
2793

            
2794
    {> NAME}    ->   NAME > ?
2795

            
2796
=head2 C<E<gt>=>
2797

            
2798
Greater than or equal tag
2799

            
2800
    {>= NAME}   ->   NAME >= ?
2801

            
2802
=head2 C<E<lt>=>
2803

            
2804
Lower than or equal tag
2805

            
2806
    {<= NAME}   ->   NAME <= ?
2807

            
2808
=head2 C<like>
2809

            
2810
Like tag
2811

            
2812
    {like NAME}   ->   NAME like ?
2813

            
2814
=head2 C<in>
2815

            
2816
In tag.
2817

            
2818
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2819

            
2820
=head2 C<insert_param>
2821

            
2822
Insert parameter tag.
2823

            
2824
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2825

            
2826
=head2 C<update_param>
2827

            
2828
Updata parameter tag.
2829

            
2830
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2831

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

            
2834
=head2 C<DBIX_CUSTOM_DEBUG>
2835

            
2836
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2837
executed SQL is printed to STDERR.
2838

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

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

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

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

            
2848
C<< <kimoto.yuki at gmail.com> >>
2849

            
2850
L<http://github.com/yuki-kimoto/DBIx-Custom>
2851

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2852
=head1 AUTHOR
2853

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

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

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

            
2860
This program is free software; you can redistribute it and/or modify it
2861
under the same terms as Perl itself.
2862

            
2863
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2864

            
2865