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

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
3
our $VERSION = '0.1683';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
cleanup
Yuki Kimoto authored on 2011-04-25
19
use DBIx::Custom::Util qw/_array_to_hash _subname/;
improved debug message
Yuki Kimoto authored on 2011-05-23
20
use Encode qw/encode 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;
improved debug message
Yuki Kimoto authored on 2011-05-23
23
use constant DEBUG_ENCODING => $ENV{DBIX_CUSTOM_DEBUG_ENCODING} || 'UTF-8';
added environment variable D...
Yuki Kimoto authored on 2011-04-02
24

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
366
sub DESTROY { }
367

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

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

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

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

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

            
569
        return $result;
570
    }
cleanup
Yuki Kimoto authored on 2011-04-02
571
    
572
    # Not select statement
573
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
574
}
575

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

            
cleanup
yuki-kimoto authored on 2010-10-17
578
sub insert {
579
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
580
    
cleanup
yuki-kimoto authored on 2010-10-17
581
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
582
    my $table  = delete $args{table};
cleanup
Yuki Kimoto authored on 2011-04-25
583
    croak qq{"table" option must be specified } . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
584
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
585
    my $param  = delete $args{param} || {};
586
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
587
    my $query_return  = delete $args{query};
588

            
589
    # Check arguments
590
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
591
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
592
          unless $INSERT_ARGS{$name};
593
    }
594

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

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

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

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

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

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
673
sub include_model {
674
    my ($self, $name_space, $model_infos) = @_;
675
    
cleanup
Yuki Kimoto authored on 2011-04-02
676
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
677
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
678
    
679
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
680
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
681

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
762
sub method {
763
    my $self = shift;
764
    
cleanup
Yuki Kimoto authored on 2011-04-02
765
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
766
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
767
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
768
    
769
    return $self;
770
}
771

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
772
sub model {
773
    my ($self, $name, $model) = @_;
774
    
cleanup
Yuki Kimoto authored on 2011-04-02
775
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
776
    if ($model) {
777
        $self->models->{$name} = $model;
778
        return $self;
779
    }
780
    
781
    # Check model existance
cleanup
Yuki Kimoto authored on 2011-04-25
782
    croak qq{Model "$name" is not included } . _subname
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
783
      unless $self->models->{$name};
784
    
cleanup
Yuki Kimoto authored on 2011-04-02
785
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
786
    return $self->models->{$name};
787
}
788

            
cleanup
Yuki Kimoto authored on 2011-03-21
789
sub mycolumn {
790
    my ($self, $table, $columns) = @_;
791
    
cleanup
Yuki Kimoto authored on 2011-04-02
792
    # Create column clause
793
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
794
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
795
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
796
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
797
    
798
    return join (', ', @column);
799
}
800

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
831
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
832
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
833
    
834
    # Register filter
835
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
836
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
837
    
cleanup
Yuki Kimoto authored on 2011-04-02
838
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
839
}
packaging one directory
yuki-kimoto authored on 2009-11-16
840

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

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

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

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

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

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

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

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
997
sub setup_model {
998
    my $self = shift;
999
    
cleanup
Yuki Kimoto authored on 2011-04-02
1000
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1001
    $self->each_column(
1002
        sub {
1003
            my ($self, $table, $column, $column_info) = @_;
1004
            if (my $model = $self->models->{$table}) {
1005
                push @{$model->columns}, $column;
1006
            }
1007
        }
1008
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1009
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1010
}
1011

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

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

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

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

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

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

            
1094
sub update_at {
1095
    my ($self, %args) = @_;
1096
    
cleanup
Yuki Kimoto authored on 2011-04-02
1097
    # Arguments
1098
    my $primary_keys = delete $args{primary_key};
1099
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1100
    my $where = delete $args{where};
1101
    
1102

            
1103
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1104
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
1105
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-03-21
1106
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1107
    }
1108
    
cleanup
Yuki Kimoto authored on 2011-04-02
1109
    # Create where parameter
1110
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1111
    
cleanup
Yuki Kimoto authored on 2011-04-02
1112
    return $self->update(where => $where_param, %args);
1113
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1114

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1115
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1116
    my ($self, $param, $opt) = @_;
1117
    
cleanup
Yuki Kimoto authored on 2011-04-02
1118
    # Create update parameter tag
added EXPERIMENTAL assign_ta...
Yuki Kimoto authored on 2011-04-26
1119
    my $tag = $self->assign_tag($param);
1120
    $tag = "set $tag" unless $opt->{no_set};
1121

            
cleanup
Yuki Kimoto authored on 2011-04-02
1122
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1123
}
1124

            
cleanup
Yuki Kimoto authored on 2011-01-25
1125
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1126
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1127
    
1128
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1129
    return DBIx::Custom::Where->new(
1130
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1131
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1132
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1133
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1134
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1135
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1136

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

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

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1205
sub _connect {
1206
    my $self = shift;
1207
    
1208
    # Attributes
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1209
    my $dsn = $self->data_source || $self->dsn;
1210
    croak qq{"dsn" must be specified } . _subname
1211
      unless $dsn;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1212
    my $user        = $self->user;
1213
    my $password    = $self->password;
1214
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1215
    
1216
    # Connect
1217
    my $dbh = eval {DBI->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1218
        $dsn,
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1219
        $user,
1220
        $password,
1221
        {
1222
            %{$self->default_dbi_option},
1223
            %$dbi_option
1224
        }
1225
    )};
1226
    
1227
    # Connect error
cleanup
Yuki Kimoto authored on 2011-04-25
1228
    croak "$@ " . _subname if $@;
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1229
    
1230
    return $dbh;
1231
}
1232

            
cleanup
yuki-kimoto authored on 2010-10-17
1233
sub _croak {
1234
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1235
    
1236
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1237
    $append ||= "";
1238
    
1239
    # Verbose
1240
    if ($Carp::Verbose) { croak $error }
1241
    
1242
    # Not verbose
1243
    else {
1244
        
1245
        # Remove line and module infromation
1246
        my $at_pos = rindex($error, ' at ');
1247
        $error = substr($error, 0, $at_pos);
1248
        $error =~ s/\s+$//;
1249
        croak "$error$append";
1250
    }
1251
}
1252

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1253
sub _need_tables {
1254
    my ($self, $tree, $need_tables, $tables) = @_;
1255
    
cleanup
Yuki Kimoto authored on 2011-04-02
1256
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1257
    foreach my $table (@$tables) {
1258
        if ($tree->{$table}) {
1259
            $need_tables->{$table} = 1;
1260
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1261
        }
1262
    }
1263
}
1264

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1306
sub _remove_duplicate_table {
1307
    my ($self, $tables, $main_table) = @_;
1308
    
1309
    # Remove duplicate table
1310
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1311
    delete $tables{$main_table} if $main_table;
1312
    
1313
    return [keys %tables, $main_table ? $main_table : ()];
1314
}
1315

            
cleanup
Yuki Kimoto authored on 2011-04-02
1316
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1317
    my ($self, $source) = @_;
1318
    
cleanup
Yuki Kimoto authored on 2011-04-02
1319
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1320
    my $tables = [];
1321
    my $safety_character = $self->safety_character;
1322
    my $q = $self->reserved_word_quote;
1323
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1324
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1325
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1326
    while ($source =~ /$table_re/g) {
1327
        push @$tables, $1;
1328
    }
1329
    
1330
    return $tables;
1331
}
1332

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

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1375
# DEPRECATED!
1376
__PACKAGE__->attr('data_source');
1377

            
cleanup
Yuki Kimoto authored on 2011-01-25
1378
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1379
__PACKAGE__->attr(
1380
    dbi_options => sub { {} },
1381
    filter_check  => 1
1382
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1383

            
cleanup
Yuki Kimoto authored on 2011-01-25
1384
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1385
sub default_bind_filter {
1386
    my $self = shift;
1387
    
1388
    if (@_) {
1389
        my $fname = $_[0];
1390
        
1391
        if (@_ && !$fname) {
1392
            $self->{default_out_filter} = undef;
1393
        }
1394
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1395
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1396
              unless exists $self->filters->{$fname};
1397
        
1398
            $self->{default_out_filter} = $self->filters->{$fname};
1399
        }
1400
        return $self;
1401
    }
1402
    
1403
    return $self->{default_out_filter};
1404
}
1405

            
cleanup
Yuki Kimoto authored on 2011-01-25
1406
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1407
sub default_fetch_filter {
1408
    my $self = shift;
1409
    
1410
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1411
        my $fname = $_[0];
1412

            
cleanup
Yuki Kimoto authored on 2011-01-12
1413
        if (@_ && !$fname) {
1414
            $self->{default_in_filter} = undef;
1415
        }
1416
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1417
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1418
              unless exists $self->filters->{$fname};
1419
        
1420
            $self->{default_in_filter} = $self->filters->{$fname};
1421
        }
1422
        
1423
        return $self;
1424
    }
1425
    
many changed
Yuki Kimoto authored on 2011-01-23
1426
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1427
}
1428

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1429
# DEPRECATED!
1430
sub insert_param {
1431
    warn "insert_param is renamed to insert_param_tag."
1432
       . " insert_param is DEPRECATED!";
1433
    return shift->insert_param_tag(@_);
1434
}
1435

            
cleanup
Yuki Kimoto authored on 2011-01-25
1436
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1437
sub register_tag_processor {
1438
    return shift->query_builder->register_tag_processor(@_);
1439
}
1440

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1441
# DEPRECATED!
1442
sub update_param {
1443
    warn "update_param is renamed to update_param_tag."
1444
       . " update_param is DEPRECATED!";
1445
    return shift->update_param_tag(@_);
1446
}
cleanup
Yuki Kimoto authored on 2011-03-08
1447
# DEPRECATED!
1448
sub _push_relation {
1449
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1450
    
1451
    if (keys %{$relation || {}}) {
1452
        push @$sql, $need_where ? 'where' : 'and';
1453
        foreach my $rcolumn (keys %$relation) {
1454
            my $table1 = (split (/\./, $rcolumn))[0];
1455
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1456
            push @$tables, ($table1, $table2);
1457
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1458
        }
1459
    }
1460
    pop @$sql if $sql->[-1] eq 'and';    
1461
}
1462

            
1463
# DEPRECATED!
1464
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1465
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1466
    
1467
    if (keys %{$relation || {}}) {
1468
        foreach my $rcolumn (keys %$relation) {
1469
            my $table1 = (split (/\./, $rcolumn))[0];
1470
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1471
            my $table1_exists;
1472
            my $table2_exists;
1473
            foreach my $table (@$tables) {
1474
                $table1_exists = 1 if $table eq $table1;
1475
                $table2_exists = 1 if $table eq $table2;
1476
            }
1477
            unshift @$tables, $table1 unless $table1_exists;
1478
            unshift @$tables, $table2 unless $table2_exists;
1479
        }
1480
    }
1481
}
1482

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1485
=head1 NAME
1486

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

            
1489
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1490

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1491
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1492
    
1493
    # Connect
1494
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1495
        dsn => "dbi:mysql:database=dbname",
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1496
        user => 'ken',
1497
        password => '!LFKD%$&',
1498
        dbi_option => {mysql_enable_utf8 => 1}
1499
    );
cleanup
yuki-kimoto authored on 2010-08-05
1500

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1501
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1502
    $dbi->insert(
1503
        table  => 'book',
1504
        param  => {title => 'Perl', author => 'Ken'}
1505
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1506
    
1507
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1508
    $dbi->update(
1509
        table  => 'book', 
1510
        param  => {title => 'Perl', author => 'Ken'}, 
1511
        where  => {id => 5},
1512
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1513
    
1514
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1515
    $dbi->delete(
1516
        table  => 'book',
1517
        where  => {author => 'Ken'},
1518
    );
cleanup
yuki-kimoto authored on 2010-08-05
1519

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

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

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

            
1558
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1559

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1564
There are many basic methods to execute various queries.
1565
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1566
C<delete_all()>, C<select()>,
1567
C<insert_at()>, C<update_at()>, 
1568
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1569

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1570
=item *
1571

            
1572
Filter when data is send or receive.
1573

            
1574
=item *
1575

            
1576
Data filtering system
1577

            
1578
=item *
1579

            
1580
Model support.
1581

            
1582
=item *
1583

            
1584
Generate where clause dinamically.
1585

            
1586
=item *
1587

            
1588
Generate join clause dinamically.
1589

            
1590
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1591

            
1592
=head1 GUIDE
1593

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

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

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

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

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

            
1604
    my $connector = $dbi->connector;
1605
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1606

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

            
1610
This is L<DBIx::Connector> example. Please pass
1611
C<default_dbi_option> to L<DBIx::Connector>.
1612

            
1613
    my $connector = DBIx::Connector->new(
1614
        "dbi:mysql:database=$DATABASE",
1615
        $USER,
1616
        $PASSWORD,
1617
        DBIx::Custom->new->default_dbi_option
1618
    );
1619
    
1620
    my $dbi = DBIx::Custom->new(connector => $connector);
1621

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1622
=head2 C<dsn>
1623

            
1624
    my $dsn = $dbi->dsn;
1625
    $dbi    = $dbi->dsn("DBI:mysql:database=dbname");
packaging one directory
yuki-kimoto authored on 2009-11-16
1626

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1627
Data source name, used when C<connect()> is executed.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1628

            
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1629
C<data_source> is DEPRECATED! It is renamed to C<dsn>.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1630

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

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

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

            
1639
=head2 C<default_dbi_option>
1640

            
1641
    my $default_dbi_option = $dbi->default_dbi_option;
1642
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1643

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1647
    {
1648
        RaiseError => 1,
1649
        PrintError => 0,
1650
        AutoCommit => 1,
1651
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1652

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

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

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

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

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

            
1665
    my $models = $dbi->models;
1666
    $dbi       = $dbi->models(\%models);
1667

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1670
=head2 C<password>
1671

            
1672
    my $password = $dbi->password;
1673
    $dbi         = $dbi->password('lkj&le`@s');
1674

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

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

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

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

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

            
1686
     my reserved_word_quote = $dbi->reserved_word_quote;
1687
     $dbi                   = $dbi->reserved_word_quote('"');
1688

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1708
    my $user = $dbi->user;
1709
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1710

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1721
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1722
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1723
        'issue_date' => {
1724
            out => 'tp_to_date',
1725
            in  => 'date_to_tp',
1726
            end => 'tp_to_displaydate'
1727
        },
1728
        'write_date' => {
1729
            out => 'tp_to_date',
1730
            in  => 'date_to_tp',
1731
            end => 'tp_to_displaydate'
1732
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1733
    );
1734

            
update pod
Yuki Kimoto authored on 2011-03-13
1735
Apply filter to columns.
1736
C<out> filter is executed before data is send to database.
1737
C<in> filter is executed after a row is fetch.
1738
C<end> filter is execute after C<in> filter is executed.
1739

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1742
       PETTERN         EXAMPLE
1743
    1. Column        : author
1744
    2. Table.Column  : book.author
1745
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1746

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

            
1750
You can set multiple filters at once.
1751

            
1752
    $dbi->apply_filter(
1753
        'book',
1754
        [qw/issue_date write_date/] => {
1755
            out => 'tp_to_date',
1756
            in  => 'date_to_tp',
1757
            end => 'tp_to_displaydate'
1758
        }
1759
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1760

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

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

            
1765
Create assign tag.
1766

            
1767
    title = {? title}, author = {? author}
1768

            
1769
This is equal to C<update_param_tag> exept that set is not added.
1770

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1773
    my $dbi = DBIx::Custom->connect(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
1774
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
1775
        user => 'ken',
1776
        password => '!LFKD%$&',
1777
        dbi_option => {mysql_enable_utf8 => 1}
1778
    );
1779

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1788
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1789
        table => 'book',
1790
        primary_key => 'id',
1791
        join => [
1792
            'inner join company on book.comparny_id = company.id'
1793
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1794
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1795
            publish_date => {
1796
                out => 'tp_to_date',
1797
                in => 'date_to_tp',
1798
                end => 'tp_to_displaydate'
1799
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1800
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1801
    );
1802

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

            
1806
   $dbi->model('book')->select(...);
1807

            
cleanup
yuki-kimoto authored on 2010-10-17
1808
=head2 C<create_query>
1809
    
1810
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1811
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1812
    );
update document
yuki-kimoto authored on 2009-11-19
1813

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

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

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

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

            
1824
    my $dbh = $dbi->dbh;
1825

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

            
1829
=head2 C<each_column>
1830

            
1831
    $dbi->each_column(
1832
        sub {
1833
            my ($dbi, $table, $column, $column_info) = @_;
1834
            
1835
            my $type = $column_info->{TYPE_NAME};
1836
            
1837
            if ($type eq 'DATE') {
1838
                # ...
1839
            }
1840
        }
1841
    );
1842

            
1843
Iterate all column informations of all table from database.
1844
Argument is callback when one column is found.
1845
Callback receive four arguments, dbi object, table name,
1846
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1847

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1850
    my $result = $dbi->execute(
1851
        "select * from book where {= title} and {like author}",
1852
        param => {title => 'Perl', author => '%Ken%'}
1853
    );
1854

            
1855
Execute SQL, containing tags.
1856
Return value is L<DBIx::Custom::Result> in select statement, or
1857
the count of affected rows in insert, update, delete statement.
1858

            
1859
Tag is turned into the statement containing place holder
1860
before SQL is executed.
1861

            
1862
    select * from where title = ? and author like ?;
1863

            
1864
See also L<Tags/Tags>.
1865

            
1866
The following opitons are currently available.
1867

            
1868
=over 4
1869

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

            
1872
Table names for filtering.
1873

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

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

            
1879

            
1880

            
1881

            
1882

            
1883

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

            
1886
Filter, executed before data is send to database. This is array reference.
1887
Filter value is code reference or
1888
filter name registerd by C<register_filter()>.
1889

            
1890
    # Basic
1891
    $dbi->execute(
1892
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1893
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1894
            title  => sub { uc $_[0] }
1895
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1896
        }
update pod
Yuki Kimoto authored on 2011-03-13
1897
    );
1898
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1899
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1900
    $dbi->execute(
1901
        $sql,
1902
        filter => [
1903
            [qw/title author/]  => sub { uc $_[0] }
1904
        ]
1905
    );
1906
    
1907
    # Filter name
1908
    $dbi->execute(
1909
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1910
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1911
            title  => 'upper_case',
1912
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1913
        }
update pod
Yuki Kimoto authored on 2011-03-13
1914
    );
1915

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

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

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

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

            
1924
Delete statement.
1925

            
1926
The following opitons are currently available.
1927

            
update pod
Yuki Kimoto authored on 2011-03-13
1928
=over 4
1929

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

            
1932
Table name.
1933

            
1934
    $dbi->delete(table => 'book');
1935

            
1936
=item C<where>
1937

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1938
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1939
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1940
    
1941
    # Hash reference
1942
    $dbi->delete(where => {title => 'Perl'});
1943
    
1944
    # DBIx::Custom::Where object
1945
    my $where = $dbi->where(
1946
        clause => ['and', '{= author}', '{like title}'],
1947
        param  => {author => 'Ken', title => '%Perl%'}
1948
    );
1949
    $dbi->delete(where => $where);
1950

            
updated pod
Yuki Kimoto authored on 2011-04-25
1951
    # String(with where_param option)
1952
    $dbi->delete(
1953
        where => '{like title}',
1954
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1955
    );
1956
    
update pod
Yuki Kimoto authored on 2011-03-13
1957
=item C<append>
1958

            
1959
Append statement to last of SQL. This is string.
1960

            
1961
    $dbi->delete(append => 'order by title');
1962

            
1963
=item C<filter>
1964

            
1965
Filter, executed before data is send to database. This is array reference.
1966
Filter value is code reference or
1967
filter name registerd by C<register_filter()>.
1968

            
1969
    # Basic
1970
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1971
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1972
            title  => sub { uc $_[0] }
1973
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1974
        }
update pod
Yuki Kimoto authored on 2011-03-13
1975
    );
1976
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1977
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1978
    $dbi->delete(
1979
        filter => [
1980
            [qw/title author/]  => sub { uc $_[0] }
1981
        ]
1982
    );
1983
    
1984
    # Filter name
1985
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1986
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1987
            title  => 'upper_case',
1988
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1989
        }
update pod
Yuki Kimoto authored on 2011-03-13
1990
    );
1991

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

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

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

            
1998
Create column clause. The follwoing column clause is created.
1999

            
2000
    book.author as book__author,
2001
    book.title as book__title
2002

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

            
2005
Get L<DBIx::Custom::Query> object instead of executing SQL.
2006
This is true or false value.
2007

            
2008
    my $query = $dbi->delete(query => 1);
2009

            
2010
You can check SQL.
2011

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2014
=back
2015

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

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

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

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

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

            
2027
    $dbi->delete_at(
2028
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2029
        primary_key => 'id',
2030
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2031
    );
2032

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2041
Primary key. This is constant value or array reference.
2042
    
2043
    # Constant value
2044
    $dbi->delete(primary_key => 'id');
2045

            
2046
    # Array reference
2047
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2048

            
2049
This is used to create where clause.
2050

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

            
2053
Where clause, created from primary key information.
2054
This is constant value or array reference.
2055

            
2056
    # Constant value
2057
    $dbi->delete(where => 5);
2058

            
2059
    # Array reference
2060
    $dbi->delete(where => [3, 5]);
2061

            
2062
In first examle, the following SQL is created.
2063

            
2064
    delete from book where id = ?;
2065

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2068
=back
2069

            
cleanup
yuki-kimoto authored on 2010-10-17
2070
=head2 C<insert>
2071

            
update pod
Yuki Kimoto authored on 2011-03-13
2072
    $dbi->insert(
2073
        table  => 'book', 
2074
        param  => {title => 'Perl', author => 'Ken'}
2075
    );
2076

            
2077
Insert statement.
2078

            
2079
The following opitons are currently available.
2080

            
update pod
Yuki Kimoto authored on 2011-03-13
2081
=over 4
2082

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

            
2085
Table name.
2086

            
2087
    $dbi->insert(table => 'book');
2088

            
2089
=item C<param>
2090

            
2091
Insert data. This is hash reference.
2092

            
2093
    $dbi->insert(param => {title => 'Perl'});
2094

            
2095
=item C<append>
2096

            
2097
Append statement to last of SQL. This is string.
2098

            
2099
    $dbi->insert(append => 'order by title');
2100

            
2101
=item C<filter>
2102

            
2103
Filter, executed before data is send to database. This is array reference.
2104
Filter value is code reference or
2105
filter name registerd by C<register_filter()>.
2106

            
2107
    # Basic
2108
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2109
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2110
            title  => sub { uc $_[0] }
2111
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2112
        }
update pod
Yuki Kimoto authored on 2011-03-13
2113
    );
2114
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2115
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2116
    $dbi->insert(
2117
        filter => [
2118
            [qw/title author/]  => sub { uc $_[0] }
2119
        ]
2120
    );
2121
    
2122
    # Filter name
2123
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2124
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2125
            title  => 'upper_case',
2126
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2127
        }
update pod
Yuki Kimoto authored on 2011-03-13
2128
    );
2129

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

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

            
2134
Get L<DBIx::Custom::Query> object instead of executing SQL.
2135
This is true or false value.
2136

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

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

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

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

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

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

            
2149
    $dbi->insert_at(
2150
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2151
        primary_key => 'id',
2152
        where => '5',
2153
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2154
    );
2155

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2160
=over 4
2161

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

            
2164
Primary key. This is constant value or array reference.
2165
    
2166
    # Constant value
2167
    $dbi->insert(primary_key => 'id');
2168

            
2169
    # Array reference
2170
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2171

            
2172
This is used to create parts of insert data.
2173

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

            
2176
Parts of Insert data, create from primary key information.
2177
This is constant value or array reference.
2178

            
2179
    # Constant value
2180
    $dbi->insert(where => 5);
2181

            
2182
    # Array reference
2183
    $dbi->insert(where => [3, 5]);
2184

            
2185
In first examle, the following SQL is created.
2186

            
2187
    insert into book (id, title) values (?, ?);
2188

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2191
=back
2192

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

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

            
2197
Create insert parameter tag.
2198

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2208
    lib / MyModel.pm
2209
        / MyModel / book.pm
2210
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2211

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

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

            
2216
    package MyModel;
2217
    
2218
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2219
    
2220
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2221

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2226
    package MyModel::book;
2227
    
2228
    use base 'MyModel';
2229
    
2230
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2231

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2234
    package MyModel::company;
2235
    
2236
    use base 'MyModel';
2237
    
2238
    1;
2239
    
2240
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2241

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

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

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

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

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

            
2253
Merge paramters.
2254

            
2255
$param:
2256

            
2257
    {key1 => [1, 1], key2 => 2}
2258

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

            
2261
    $dbi->method(
2262
        update_or_insert => sub {
2263
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2264
            
2265
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2266
        },
2267
        find_or_create   => sub {
2268
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2269
            
2270
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2271
        }
2272
    );
2273

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

            
2276
    $dbi->update_or_insert;
2277
    $dbi->find_or_create;
2278

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

            
2281
    $dbi->model('book')->method(
2282
        insert => sub { ... },
2283
        update => sub { ... }
2284
    );
2285
    
2286
    my $model = $dbi->model('book');
2287

            
2288
Set and get a L<DBIx::Custom::Model> object,
2289

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

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

            
2294
Create column clause for myself. The follwoing column clause is created.
2295

            
2296
    book.author as author,
2297
    book.title as title
2298

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2301
    my $dbi = DBIx::Custom->new(
data_source is DEPRECATED! I...
Yuki Kimoto authored on 2011-06-06
2302
        dsn => "dbi:mysql:database=dbname",
update pod
Yuki Kimoto authored on 2011-03-13
2303
        user => 'ken',
2304
        password => '!LFKD%$&',
2305
        dbi_option => {mysql_enable_utf8 => 1}
2306
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2307

            
2308
Create a new L<DBIx::Custom> object.
2309

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

            
2312
    my $not_exists = $dbi->not_exists;
2313

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2317
=head2 C<register_filter>
2318

            
update pod
Yuki Kimoto authored on 2011-03-13
2319
    $dbi->register_filter(
2320
        # Time::Piece object to database DATE format
2321
        tp_to_date => sub {
2322
            my $tp = shift;
2323
            return $tp->strftime('%Y-%m-%d');
2324
        },
2325
        # database DATE format to Time::Piece object
2326
        date_to_tp => sub {
2327
           my $date = shift;
2328
           return Time::Piece->strptime($date, '%Y-%m-%d');
2329
        }
2330
    );
cleanup
yuki-kimoto authored on 2010-10-17
2331
    
update pod
Yuki Kimoto authored on 2011-03-13
2332
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2333

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2336
    $dbi->register_tag(
2337
        update => sub {
2338
            my @columns = @_;
2339
            
2340
            # Update parameters
2341
            my $s = 'set ';
2342
            $s .= "$_ = ?, " for @columns;
2343
            $s =~ s/, $//;
2344
            
2345
            return [$s, \@columns];
2346
        }
2347
    );
cleanup
yuki-kimoto authored on 2010-10-17
2348

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2372
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2373
        table  => 'book',
2374
        column => ['author', 'title'],
2375
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2376
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2377
    
update pod
Yuki Kimoto authored on 2011-03-12
2378
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2379

            
2380
The following opitons are currently available.
2381

            
2382
=over 4
2383

            
2384
=item C<table>
2385

            
2386
Table name.
2387

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

            
2390
=item C<column>
2391

            
2392
Column clause. This is array reference or constant value.
2393

            
2394
    # Hash refernce
2395
    $dbi->select(column => ['author', 'title']);
2396
    
2397
    # Constant value
2398
    $dbi->select(column => 'author');
2399

            
2400
Default is '*' unless C<column> is specified.
2401

            
2402
    # Default
2403
    $dbi->select(column => '*');
2404

            
2405
=item C<where>
2406

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2407
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2408
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2409
    
2410
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2411
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2412
    
update pod
Yuki Kimoto authored on 2011-03-12
2413
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2414
    my $where = $dbi->where(
2415
        clause => ['and', '{= author}', '{like title}'],
2416
        param  => {author => 'Ken', title => '%Perl%'}
2417
    );
update pod
Yuki Kimoto authored on 2011-03-12
2418
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2419

            
updated pod
Yuki Kimoto authored on 2011-04-25
2420
    # String(with where_param option)
2421
    $dbi->select(
2422
        where => '{like title}',
2423
        where_param => {title => '%Perl%'}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2424
    );
2425
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2426
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2427

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

            
2430
    $dbi->select(join =>
2431
        [
2432
            'left outer join company on book.company_id = company_id',
2433
            'left outer join location on company.location_id = location.id'
2434
        ]
2435
    );
2436

            
2437
If column cluase or where clause contain table name like "company.name",
2438
needed join clause is used automatically.
2439

            
2440
    $dbi->select(
2441
        table => 'book',
2442
        column => ['company.location_id as company__location_id'],
2443
        where => {'company.name' => 'Orange'},
2444
        join => [
2445
            'left outer join company on book.company_id = company.id',
2446
            'left outer join location on company.location_id = location.id'
2447
        ]
2448
    );
2449

            
2450
In above select, the following SQL is created.
2451

            
2452
    select company.location_id as company__location_id
2453
    from book
2454
      left outer join company on book.company_id = company.id
2455
    where company.name = Orange
2456

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

            
2459
Parameter shown before where clause.
2460
    
2461
    $dbi->select(
2462
        table => 'table1',
2463
        column => 'table1.key1 as table1_key1, key2, key3',
2464
        where   => {'table1.key2' => 3},
2465
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2466
                  ' as table2 on table1.key1 = table2.key1'],
2467
        param => {'table2.key3' => 5}
2468
    );
2469

            
2470
For example, if you want to contain tag in join clause, 
2471
you can pass parameter by C<param> option.
2472

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

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

            
2477
    $dbi->select(append => 'order by title');
2478

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

            
2481
Wrap statement. This is array reference.
2482

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

            
2485
This option is for Oracle and SQL Server paging process.
2486

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

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

            
2493
    # Basic
2494
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2495
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2496
            title  => sub { uc $_[0] }
2497
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2498
        }
update pod
Yuki Kimoto authored on 2011-03-12
2499
    );
2500
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2501
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2502
    $dbi->select(
2503
        filter => [
2504
            [qw/title author/]  => sub { uc $_[0] }
2505
        ]
2506
    );
2507
    
2508
    # Filter name
2509
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2510
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2511
            title  => 'upper_case',
2512
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2513
        }
update pod
Yuki Kimoto authored on 2011-03-12
2514
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2515

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

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

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

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

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

            
2527
    my $sql = $query->sql;
2528

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

            
2531
Specify database data type.
2532

            
2533
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2534
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2535

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

            
2538
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2539

            
update pod
Yuki Kimoto authored on 2011-03-12
2540
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2541

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

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

            
2546
    $dbi->select_at(
2547
        table => 'book',
2548
        primary_key => 'id',
2549
        where => '5'
2550
    );
2551

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2560
Primary key. This is constant value or array reference.
2561
    
2562
    # Constant value
2563
    $dbi->select(primary_key => 'id');
2564

            
2565
    # Array reference
2566
    $dbi->select(primary_key => ['id1', 'id2' ]);
2567

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

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

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

            
2575
    # Constant value
2576
    $dbi->select(where => 5);
2577

            
2578
    # Array reference
2579
    $dbi->select(where => [3, 5]);
2580

            
2581
In first examle, the following SQL is created.
2582

            
2583
    select * from book where id = ?
2584

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2591
    $dbi->update(
2592
        table  => 'book',
2593
        param  => {title => 'Perl'},
2594
        where  => {id => 4}
2595
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2596

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2601
=over 4
2602

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2605
Table name.
2606

            
2607
    $dbi->update(table => 'book');
2608

            
2609
=item C<param>
2610

            
2611
Update data. This is hash reference.
2612

            
2613
    $dbi->update(param => {title => 'Perl'});
2614

            
2615
=item C<where>
2616

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2617
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2618
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2619
    
2620
    # Hash reference
2621
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2622
    
2623
    # DBIx::Custom::Where object
2624
    my $where = $dbi->where(
2625
        clause => ['and', '{= author}', '{like title}'],
2626
        param  => {author => 'Ken', title => '%Perl%'}
2627
    );
2628
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2629
    
updated pod
Yuki Kimoto authored on 2011-04-25
2630
    # String(with where_param option)
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2631
    $dbi->update(
updated pod
Yuki Kimoto authored on 2011-04-25
2632
        param => {title => 'Perl'},
2633
        where => '{= id}',
2634
        where_param => {id => 2}
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2635
    );
DEPRECATED select() param op...
Yuki Kimoto authored on 2011-04-25
2636
    
update pod
Yuki Kimoto authored on 2011-03-13
2637
=item C<append>
2638

            
2639
Append statement to last of SQL. This is string.
2640

            
2641
    $dbi->update(append => 'order by title');
2642

            
2643
=item C<filter>
2644

            
2645
Filter, executed before data is send to database. This is array reference.
2646
Filter value is code reference or
2647
filter name registerd by C<register_filter()>.
2648

            
2649
    # Basic
2650
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2651
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2652
            title  => sub { uc $_[0] }
2653
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2654
        }
update pod
Yuki Kimoto authored on 2011-03-13
2655
    );
2656
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2657
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2658
    $dbi->update(
2659
        filter => [
2660
            [qw/title author/]  => sub { uc $_[0] }
2661
        ]
2662
    );
2663
    
2664
    # Filter name
2665
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2666
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2667
            title  => 'upper_case',
2668
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2669
        }
update pod
Yuki Kimoto authored on 2011-03-13
2670
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2671

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

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

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

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

            
2681
You can check SQL.
2682

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2685
=back
2686

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

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

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

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

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

            
2698
    $dbi->update_at(
2699
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2700
        primary_key => 'id',
2701
        where => '5',
2702
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2703
    );
2704

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2709
=over 4
2710

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

            
2713
Primary key. This is constant value or array reference.
2714
    
2715
    # Constant value
2716
    $dbi->update(primary_key => 'id');
2717

            
2718
    # Array reference
2719
    $dbi->update(primary_key => ['id1', 'id2' ]);
2720

            
2721
This is used to create where clause.
2722

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

            
2725
Where clause, created from primary key information.
2726
This is constant value or array reference.
2727

            
2728
    # Constant value
2729
    $dbi->update(where => 5);
2730

            
2731
    # Array reference
2732
    $dbi->update(where => [3, 5]);
2733

            
2734
In first examle, the following SQL is created.
2735

            
2736
    update book set title = ? where id = ?
2737

            
2738
Place holders are set to 'Perl' and 5.
2739

            
update pod
Yuki Kimoto authored on 2011-03-13
2740
=back
2741

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

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

            
2746
Create update parameter tag.
2747

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2753
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2754
        {title => 'a', age => 2}
2755
        {no_set => 1}
2756
    );
2757

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2762
    my $where = $dbi->where(
2763
        clause => ['and', '{= title}', '{= author}'],
2764
        param => {title => 'Perl', author => 'Ken'}
2765
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2766

            
2767
Create a new L<DBIx::Custom::Where> object.
2768

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2776
=head1 Tags
2777

            
2778
The following tags is available.
2779

            
2780
=head2 C<?>
2781

            
2782
Placeholder tag.
2783

            
2784
    {? NAME}    ->   ?
2785

            
2786
=head2 C<=>
2787

            
2788
Equal tag.
2789

            
2790
    {= NAME}    ->   NAME = ?
2791

            
2792
=head2 C<E<lt>E<gt>>
2793

            
2794
Not equal tag.
2795

            
2796
    {<> NAME}   ->   NAME <> ?
2797

            
2798
=head2 C<E<lt>>
2799

            
2800
Lower than tag
2801

            
2802
    {< NAME}    ->   NAME < ?
2803

            
2804
=head2 C<E<gt>>
2805

            
2806
Greater than tag
2807

            
2808
    {> NAME}    ->   NAME > ?
2809

            
2810
=head2 C<E<gt>=>
2811

            
2812
Greater than or equal tag
2813

            
2814
    {>= NAME}   ->   NAME >= ?
2815

            
2816
=head2 C<E<lt>=>
2817

            
2818
Lower than or equal tag
2819

            
2820
    {<= NAME}   ->   NAME <= ?
2821

            
2822
=head2 C<like>
2823

            
2824
Like tag
2825

            
2826
    {like NAME}   ->   NAME like ?
2827

            
2828
=head2 C<in>
2829

            
2830
In tag.
2831

            
2832
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2833

            
2834
=head2 C<insert_param>
2835

            
2836
Insert parameter tag.
2837

            
2838
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2839

            
2840
=head2 C<update_param>
2841

            
2842
Updata parameter tag.
2843

            
2844
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2845

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

            
2848
=head2 C<DBIX_CUSTOM_DEBUG>
2849

            
2850
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
improved debug message
Yuki Kimoto authored on 2011-05-23
2851
executed SQL and bind values are printed to STDERR.
2852

            
2853
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2854

            
2855
DEBUG output encoding. Default to UTF-8.
added environment variable D...
Yuki Kimoto authored on 2011-04-02
2856

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

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

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

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

            
2866
C<< <kimoto.yuki at gmail.com> >>
2867

            
2868
L<http://github.com/yuki-kimoto/DBIx-Custom>
2869

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2870
=head1 AUTHOR
2871

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

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

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

            
2878
This program is free software; you can redistribute it and/or modify it
2879
under the same terms as Perl itself.
2880

            
2881
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2882

            
2883