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

            
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
3
our $VERSION = '0.1679';
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;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
19
use DBIx::Custom::Util;
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 {
improved error messages
Yuki Kimoto authored on 2011-04-18
81
        croak qq{Can't locate object method "$mname" via "$package"}
82
            . qq{ (DBIx::Custom::AUTOLOAD)}
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] || {};
improved error messages
Yuki Kimoto authored on 2011-04-18
114
        croak "$usage (table: $table) (DBIx::Custom::apply_filter)"
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) {
improved error messages
Yuki Kimoto authored on 2011-04-18
117
            croak "$usage (table: $table) (DBIx::Custom::apply_filter)"
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
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
137
            croak qq{Filter "$filter" is not registered}
improved error messages
Yuki Kimoto authored on 2011-04-18
138
                . qq{ (DBIx::Custom::apply_filter)}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
139
              if  $state eq 'name'
140
               && ! exists $self->filters->{$filter};
141
            
cleanup
Yuki Kimoto authored on 2011-04-02
142
            # Set filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
143
            my $f = $state eq 'not_defined' ? undef
144
                  : $state eq 'code'        ? $filter
145
                  : $self->filters->{$filter};
146
            $self->{filter}{$way}{$table}{$column} = $f;
147
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
148
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
149
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
150
    }
151
    
many changed
Yuki Kimoto authored on 2011-01-23
152
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
153
}
154

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
269
our %DELETE_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
270
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
271

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

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

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
291
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
292
    $where = $self->_where_to_obj($where);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
293
    
cleanup
Yuki Kimoto authored on 2011-04-02
294
    # Where clause
295
    my $where_clause = $where->to_string;
improved error messages
Yuki Kimoto authored on 2011-04-18
296
    croak qq{"where" must be specified (DBIx::Custom::delete)}
cleanup
Yuki Kimoto authored on 2011-04-02
297
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
298

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
343
sub DESTROY { }
344

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

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

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

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

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

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

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

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

            
557
    # Check arguments
558
    foreach my $name (keys %args) {
improved error messages
Yuki Kimoto authored on 2011-04-18
559
        croak qq{"$name" is wrong option (DBIx::Custom::insert)}
cleanup
Yuki Kimoto authored on 2011-04-02
560
          unless $INSERT_ARGS{$name};
561
    }
562

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-12
1376
        if (@_ && !$fname) {
1377
            $self->{default_in_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_in_filter} = $self->filters->{$fname};
1384
        }
1385
        
1386
        return $self;
1387
    }
1388
    
many changed
Yuki Kimoto authored on 2011-01-23
1389
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1390
}
1391

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1448
=head1 NAME
1449

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

            
1452
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1453

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

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

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

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

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

            
1521
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1522

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1533
=item *
1534

            
1535
Filter when data is send or receive.
1536

            
1537
=item *
1538

            
1539
Data filtering system
1540

            
1541
=item *
1542

            
1543
Model support.
1544

            
1545
=item *
1546

            
1547
Generate where clause dinamically.
1548

            
1549
=item *
1550

            
1551
Generate join clause dinamically.
1552

            
1553
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1554

            
1555
=head1 GUIDE
1556

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1600
=head2 C<default_dbi_option>
1601

            
1602
    my $default_dbi_option = $dbi->default_dbi_option;
1603
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1604

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

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

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

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

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

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

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

            
1626
    my $models = $dbi->models;
1627
    $dbi       = $dbi->models(\%models);
1628

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1631
=head2 C<password>
1632

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

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

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

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

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

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

            
1647
     my reserved_word_quote = $dbi->reserved_word_quote;
1648
     $dbi                   = $dbi->reserved_word_quote('"');
1649

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1711
You can set multiple filters at once.
1712

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

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

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

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

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

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

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

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

            
1757
   $dbi->model('book')->select(...);
1758

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

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

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

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

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

            
1775
    my $dbh = $dbi->dbh;
1776

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

            
1780
=head2 C<each_column>
1781

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

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

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

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

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

            
1810
Tag is turned into the statement containing place holder
1811
before SQL is executed.
1812

            
1813
    select * from where title = ? and author like ?;
1814

            
1815
See also L<Tags/Tags>.
1816

            
1817
The following opitons are currently available.
1818

            
1819
=over 4
1820

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

            
1823
Table names for filtering.
1824

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

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

            
1830

            
1831

            
1832

            
1833

            
1834

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

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

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

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

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

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

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

            
1875
Delete statement.
1876

            
1877
The following opitons are currently available.
1878

            
update pod
Yuki Kimoto authored on 2011-03-13
1879
=over 4
1880

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

            
1883
Table name.
1884

            
1885
    $dbi->delete(table => 'book');
1886

            
1887
=item C<where>
1888

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

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

            
1912
Append statement to last of SQL. This is string.
1913

            
1914
    $dbi->delete(append => 'order by title');
1915

            
1916
=item C<filter>
1917

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

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

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

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

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

            
1951
Create column clause. The follwoing column clause is created.
1952

            
1953
    book.author as book__author,
1954
    book.title as book__title
1955

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

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

            
1961
    my $query = $dbi->delete(query => 1);
1962

            
1963
You can check SQL.
1964

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1967
=back
1968

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1990
=over 4
1991

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

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

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

            
2002
This is used to create where clause.
2003

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

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

            
2009
    # Constant value
2010
    $dbi->delete(where => 5);
2011

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

            
2015
In first examle, the following SQL is created.
2016

            
2017
    delete from book where id = ?;
2018

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2021
=back
2022

            
cleanup
yuki-kimoto authored on 2010-10-17
2023
=head2 C<insert>
2024

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

            
2030
Insert statement.
2031

            
2032
The following opitons are currently available.
2033

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

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

            
2038
Table name.
2039

            
2040
    $dbi->insert(table => 'book');
2041

            
2042
=item C<param>
2043

            
2044
Insert data. This is hash reference.
2045

            
2046
    $dbi->insert(param => {title => 'Perl'});
2047

            
2048
=item C<append>
2049

            
2050
Append statement to last of SQL. This is string.
2051

            
2052
    $dbi->insert(append => 'order by title');
2053

            
2054
=item C<filter>
2055

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2096
=back
2097

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2113
=over 4
2114

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

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

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

            
2125
This is used to create parts of insert data.
2126

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

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

            
2132
    # Constant value
2133
    $dbi->insert(where => 5);
2134

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

            
2138
In first examle, the following SQL is created.
2139

            
2140
    insert into book (id, title) values (?, ?);
2141

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2144
=back
2145

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

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

            
2150
Create insert parameter tag.
2151

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2206
Merge paramters.
2207

            
2208
$param:
2209

            
2210
    {key1 => [1, 1], key2 => 2}
2211

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

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

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

            
2229
    $dbi->update_or_insert;
2230
    $dbi->find_or_create;
2231

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

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

            
2241
Set and get a L<DBIx::Custom::Model> object,
2242

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

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

            
2247
Create column clause for myself. The follwoing column clause is created.
2248

            
2249
    book.author as author,
2250
    book.title as title
2251

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

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

            
2261
Create a new L<DBIx::Custom> object.
2262

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

            
2265
    my $not_exists = $dbi->not_exists;
2266

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2270
=head2 C<register_filter>
2271

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2333
The following opitons are currently available.
2334

            
2335
=over 4
2336

            
2337
=item C<table>
2338

            
2339
Table name.
2340

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

            
2343
=item C<column>
2344

            
2345
Column clause. This is array reference or constant value.
2346

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

            
2353
Default is '*' unless C<column> is specified.
2354

            
2355
    # Default
2356
    $dbi->select(column => '*');
2357

            
2358
=item C<where>
2359

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

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

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

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

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

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

            
2405
In above select, the following SQL is created.
2406

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

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

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

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

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

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

            
2432
    $dbi->select(append => 'order by title');
2433

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

            
2436
Wrap statement. This is array reference.
2437

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

            
2440
This option is for Oracle and SQL Server paging process.
2441

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

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

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

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

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

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

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

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

            
2482
    my $sql = $query->sql;
2483

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

            
2486
Specify database data type.
2487

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

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

            
2493
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2494

            
update pod
Yuki Kimoto authored on 2011-03-12
2495
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2496

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2511
=over 4
2512

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

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

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

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

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

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

            
2530
    # Constant value
2531
    $dbi->select(where => 5);
2532

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

            
2536
In first examle, the following SQL is created.
2537

            
2538
    select * from book where id = ?
2539

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2556
=over 4
2557

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2560
Table name.
2561

            
2562
    $dbi->update(table => 'book');
2563

            
2564
=item C<param>
2565

            
2566
Update data. This is hash reference.
2567

            
2568
    $dbi->update(param => {title => 'Perl'});
2569

            
2570
=item C<where>
2571

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

            
2593
=item C<append>
2594

            
2595
Append statement to last of SQL. This is string.
2596

            
2597
    $dbi->update(append => 'order by title');
2598

            
2599
=item C<filter>
2600

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

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

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

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

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

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

            
2637
You can check SQL.
2638

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2641
=back
2642

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2665
=over 4
2666

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

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

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

            
2677
This is used to create where clause.
2678

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

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

            
2684
    # Constant value
2685
    $dbi->update(where => 5);
2686

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

            
2690
In first examle, the following SQL is created.
2691

            
2692
    update book set title = ? where id = ?
2693

            
2694
Place holders are set to 'Perl' and 5.
2695

            
update pod
Yuki Kimoto authored on 2011-03-13
2696
=back
2697

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

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

            
2702
Create update parameter tag.
2703

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

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

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

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

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

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

            
2723
Create a new L<DBIx::Custom::Where> object.
2724

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2732
=head1 Tags
2733

            
2734
The following tags is available.
2735

            
2736
=head2 C<?>
2737

            
2738
Placeholder tag.
2739

            
2740
    {? NAME}    ->   ?
2741

            
2742
=head2 C<=>
2743

            
2744
Equal tag.
2745

            
2746
    {= NAME}    ->   NAME = ?
2747

            
2748
=head2 C<E<lt>E<gt>>
2749

            
2750
Not equal tag.
2751

            
2752
    {<> NAME}   ->   NAME <> ?
2753

            
2754
=head2 C<E<lt>>
2755

            
2756
Lower than tag
2757

            
2758
    {< NAME}    ->   NAME < ?
2759

            
2760
=head2 C<E<gt>>
2761

            
2762
Greater than tag
2763

            
2764
    {> NAME}    ->   NAME > ?
2765

            
2766
=head2 C<E<gt>=>
2767

            
2768
Greater than or equal tag
2769

            
2770
    {>= NAME}   ->   NAME >= ?
2771

            
2772
=head2 C<E<lt>=>
2773

            
2774
Lower than or equal tag
2775

            
2776
    {<= NAME}   ->   NAME <= ?
2777

            
2778
=head2 C<like>
2779

            
2780
Like tag
2781

            
2782
    {like NAME}   ->   NAME like ?
2783

            
2784
=head2 C<in>
2785

            
2786
In tag.
2787

            
2788
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2789

            
2790
=head2 C<insert_param>
2791

            
2792
Insert parameter tag.
2793

            
2794
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2795

            
2796
=head2 C<update_param>
2797

            
2798
Updata parameter tag.
2799

            
2800
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2801

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

            
2804
=head2 C<DBIX_CUSTOM_DEBUG>
2805

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

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

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

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

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

            
2818
C<< <kimoto.yuki at gmail.com> >>
2819

            
2820
L<http://github.com/yuki-kimoto/DBIx-Custom>
2821

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2822
=head1 AUTHOR
2823

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

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

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

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

            
2833
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2834

            
2835