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

            
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
3
our $VERSION = '0.1681';
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
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
733
    my $param = {};
734
    foreach my $p (@params) {
735
        foreach my $column (keys %$p) {
736
            if (exists $param->{$column}) {
737
                $param->{$column} = [$param->{$column}]
738
                  unless ref $param->{$column} eq 'ARRAY';
739
                push @{$param->{$column}}, $p->{$column};
740
            }
741
            else {
742
                $param->{$column} = $p->{$column};
743
            }
744
        }
745
    }
746
    
747
    return $param;
748
}
749

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1110
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1111
}
1112

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1470
=head1 NAME
1471

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

            
1474
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1475

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

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

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

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

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

            
1543
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1544

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1555
=item *
1556

            
1557
Filter when data is send or receive.
1558

            
1559
=item *
1560

            
1561
Data filtering system
1562

            
1563
=item *
1564

            
1565
Model support.
1566

            
1567
=item *
1568

            
1569
Generate where clause dinamically.
1570

            
1571
=item *
1572

            
1573
Generate join clause dinamically.
1574

            
1575
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1576

            
1577
=head1 GUIDE
1578

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

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

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

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

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

            
1589
    my $connector = $dbi->connector;
1590
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1591

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

            
1595
This is L<DBIx::Connector> example. Please pass
1596
C<default_dbi_option> to L<DBIx::Connector>.
1597

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

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

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

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

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

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

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

            
1622
=head2 C<default_dbi_option>
1623

            
1624
    my $default_dbi_option = $dbi->default_dbi_option;
1625
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1626

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

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

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

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

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

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

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

            
1648
    my $models = $dbi->models;
1649
    $dbi       = $dbi->models(\%models);
1650

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1653
=head2 C<password>
1654

            
1655
    my $password = $dbi->password;
1656
    $dbi         = $dbi->password('lkj&le`@s');
1657

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

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

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

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

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

            
1669
     my reserved_word_quote = $dbi->reserved_word_quote;
1670
     $dbi                   = $dbi->reserved_word_quote('"');
1671

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1691
    my $user = $dbi->user;
1692
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1693

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

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

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

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

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

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

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

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

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

            
1733
You can set multiple filters at once.
1734

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

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

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

            
1748
Create assign tag.
1749

            
1750
    title = {? title}, author = {? author}
1751

            
1752
This is equal to C<update_param_tag> exept that set is not added.
1753

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

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

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

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

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

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

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

            
1789
   $dbi->model('book')->select(...);
1790

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

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

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

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

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

            
1807
    my $dbh = $dbi->dbh;
1808

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

            
1812
=head2 C<each_column>
1813

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

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

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

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

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

            
1842
Tag is turned into the statement containing place holder
1843
before SQL is executed.
1844

            
1845
    select * from where title = ? and author like ?;
1846

            
1847
See also L<Tags/Tags>.
1848

            
1849
The following opitons are currently available.
1850

            
1851
=over 4
1852

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

            
1855
Table names for filtering.
1856

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

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

            
1862

            
1863

            
1864

            
1865

            
1866

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

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

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

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

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

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

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

            
1907
Delete statement.
1908

            
1909
The following opitons are currently available.
1910

            
update pod
Yuki Kimoto authored on 2011-03-13
1911
=over 4
1912

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

            
1915
Table name.
1916

            
1917
    $dbi->delete(table => 'book');
1918

            
1919
=item C<where>
1920

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

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

            
1942
Append statement to last of SQL. This is string.
1943

            
1944
    $dbi->delete(append => 'order by title');
1945

            
1946
=item C<filter>
1947

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

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

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

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

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

            
1981
Create column clause. The follwoing column clause is created.
1982

            
1983
    book.author as book__author,
1984
    book.title as book__title
1985

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

            
1988
Get L<DBIx::Custom::Query> object instead of executing SQL.
1989
This is true or false value.
1990

            
1991
    my $query = $dbi->delete(query => 1);
1992

            
1993
You can check SQL.
1994

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1997
=back
1998

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2020
=over 4
2021

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

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

            
2029
    # Array reference
2030
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2031

            
2032
This is used to create where clause.
2033

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

            
2036
Where clause, created from primary key information.
2037
This is constant value or array reference.
2038

            
2039
    # Constant value
2040
    $dbi->delete(where => 5);
2041

            
2042
    # Array reference
2043
    $dbi->delete(where => [3, 5]);
2044

            
2045
In first examle, the following SQL is created.
2046

            
2047
    delete from book where id = ?;
2048

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2051
=back
2052

            
cleanup
yuki-kimoto authored on 2010-10-17
2053
=head2 C<insert>
2054

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

            
2060
Insert statement.
2061

            
2062
The following opitons are currently available.
2063

            
update pod
Yuki Kimoto authored on 2011-03-13
2064
=over 4
2065

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

            
2068
Table name.
2069

            
2070
    $dbi->insert(table => 'book');
2071

            
2072
=item C<param>
2073

            
2074
Insert data. This is hash reference.
2075

            
2076
    $dbi->insert(param => {title => 'Perl'});
2077

            
2078
=item C<append>
2079

            
2080
Append statement to last of SQL. This is string.
2081

            
2082
    $dbi->insert(append => 'order by title');
2083

            
2084
=item C<filter>
2085

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

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

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

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

            
2117
Get L<DBIx::Custom::Query> object instead of executing SQL.
2118
This is true or false value.
2119

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2143
=over 4
2144

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

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

            
2152
    # Array reference
2153
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2154

            
2155
This is used to create parts of insert data.
2156

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

            
2159
Parts of Insert data, create from primary key information.
2160
This is constant value or array reference.
2161

            
2162
    # Constant value
2163
    $dbi->insert(where => 5);
2164

            
2165
    # Array reference
2166
    $dbi->insert(where => [3, 5]);
2167

            
2168
In first examle, the following SQL is created.
2169

            
2170
    insert into book (id, title) values (?, ?);
2171

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2174
=back
2175

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

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

            
2180
Create insert parameter tag.
2181

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2236
Merge paramters.
2237

            
2238
$param:
2239

            
2240
    {key1 => [1, 1], key2 => 2}
2241

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

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

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

            
2259
    $dbi->update_or_insert;
2260
    $dbi->find_or_create;
2261

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

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

            
2271
Set and get a L<DBIx::Custom::Model> object,
2272

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

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

            
2277
Create column clause for myself. The follwoing column clause is created.
2278

            
2279
    book.author as author,
2280
    book.title as title
2281

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

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

            
2291
Create a new L<DBIx::Custom> object.
2292

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

            
2295
    my $not_exists = $dbi->not_exists;
2296

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2300
=head2 C<register_filter>
2301

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2363
The following opitons are currently available.
2364

            
2365
=over 4
2366

            
2367
=item C<table>
2368

            
2369
Table name.
2370

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

            
2373
=item C<column>
2374

            
2375
Column clause. This is array reference or constant value.
2376

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

            
2383
Default is '*' unless C<column> is specified.
2384

            
2385
    # Default
2386
    $dbi->select(column => '*');
2387

            
2388
=item C<where>
2389

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

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

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

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

            
2420
If column cluase or where clause contain table name like "company.name",
2421
needed join clause is used automatically.
2422

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

            
2433
In above select, the following SQL is created.
2434

            
2435
    select company.location_id as company__location_id
2436
    from book
2437
      left outer join company on book.company_id = company.id
2438
    where company.name = Orange
2439

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

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

            
2453
For example, if you want to contain tag in join clause, 
2454
you can pass parameter by C<param> option.
2455

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

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

            
2460
    $dbi->select(append => 'order by title');
2461

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

            
2464
Wrap statement. This is array reference.
2465

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

            
2468
This option is for Oracle and SQL Server paging process.
2469

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

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

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

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

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

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

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

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

            
2510
    my $sql = $query->sql;
2511

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

            
2514
Specify database data type.
2515

            
2516
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2517
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2518

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

            
2521
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2522

            
update pod
Yuki Kimoto authored on 2011-03-12
2523
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2524

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

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

            
2529
    $dbi->select_at(
2530
        table => 'book',
2531
        primary_key => 'id',
2532
        where => '5'
2533
    );
2534

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2539
=over 4
2540

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

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

            
2548
    # Array reference
2549
    $dbi->select(primary_key => ['id1', 'id2' ]);
2550

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

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

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

            
2558
    # Constant value
2559
    $dbi->select(where => 5);
2560

            
2561
    # Array reference
2562
    $dbi->select(where => [3, 5]);
2563

            
2564
In first examle, the following SQL is created.
2565

            
2566
    select * from book where id = ?
2567

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2570
=back
2571

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2584
=over 4
2585

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2588
Table name.
2589

            
2590
    $dbi->update(table => 'book');
2591

            
2592
=item C<param>
2593

            
2594
Update data. This is hash reference.
2595

            
2596
    $dbi->update(param => {title => 'Perl'});
2597

            
2598
=item C<where>
2599

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

            
2622
Append statement to last of SQL. This is string.
2623

            
2624
    $dbi->update(append => 'order by title');
2625

            
2626
=item C<filter>
2627

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

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

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

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

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

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

            
2664
You can check SQL.
2665

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2668
=back
2669

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2692
=over 4
2693

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

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

            
2701
    # Array reference
2702
    $dbi->update(primary_key => ['id1', 'id2' ]);
2703

            
2704
This is used to create where clause.
2705

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

            
2708
Where clause, created from primary key information.
2709
This is constant value or array reference.
2710

            
2711
    # Constant value
2712
    $dbi->update(where => 5);
2713

            
2714
    # Array reference
2715
    $dbi->update(where => [3, 5]);
2716

            
2717
In first examle, the following SQL is created.
2718

            
2719
    update book set title = ? where id = ?
2720

            
2721
Place holders are set to 'Perl' and 5.
2722

            
update pod
Yuki Kimoto authored on 2011-03-13
2723
=back
2724

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

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

            
2729
Create update parameter tag.
2730

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

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

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

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

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

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

            
2750
Create a new L<DBIx::Custom::Where> object.
2751

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2759
=head1 Tags
2760

            
2761
The following tags is available.
2762

            
2763
=head2 C<?>
2764

            
2765
Placeholder tag.
2766

            
2767
    {? NAME}    ->   ?
2768

            
2769
=head2 C<=>
2770

            
2771
Equal tag.
2772

            
2773
    {= NAME}    ->   NAME = ?
2774

            
2775
=head2 C<E<lt>E<gt>>
2776

            
2777
Not equal tag.
2778

            
2779
    {<> NAME}   ->   NAME <> ?
2780

            
2781
=head2 C<E<lt>>
2782

            
2783
Lower than tag
2784

            
2785
    {< NAME}    ->   NAME < ?
2786

            
2787
=head2 C<E<gt>>
2788

            
2789
Greater than tag
2790

            
2791
    {> NAME}    ->   NAME > ?
2792

            
2793
=head2 C<E<gt>=>
2794

            
2795
Greater than or equal tag
2796

            
2797
    {>= NAME}   ->   NAME >= ?
2798

            
2799
=head2 C<E<lt>=>
2800

            
2801
Lower than or equal tag
2802

            
2803
    {<= NAME}   ->   NAME <= ?
2804

            
2805
=head2 C<like>
2806

            
2807
Like tag
2808

            
2809
    {like NAME}   ->   NAME like ?
2810

            
2811
=head2 C<in>
2812

            
2813
In tag.
2814

            
2815
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2816

            
2817
=head2 C<insert_param>
2818

            
2819
Insert parameter tag.
2820

            
2821
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2822

            
2823
=head2 C<update_param>
2824

            
2825
Updata parameter tag.
2826

            
2827
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2828

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

            
2831
=head2 C<DBIX_CUSTOM_DEBUG>
2832

            
2833
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2834
executed SQL is printed to STDERR.
2835

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

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

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

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

            
2845
C<< <kimoto.yuki at gmail.com> >>
2846

            
2847
L<http://github.com/yuki-kimoto/DBIx-Custom>
2848

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2849
=head1 AUTHOR
2850

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

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

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

            
2857
This program is free software; you can redistribute it and/or modify it
2858
under the same terms as Perl itself.
2859

            
2860
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2861

            
2862