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

            
fixed merge_param bug
Yuki Kimoto authored on 2011-05-23
3
our $VERSION = '0.1682';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
cleanup
Yuki Kimoto authored on 2011-04-25
19
use DBIx::Custom::Util qw/_array_to_hash _subname/;
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(
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
28
    [qw/connector data_source password pid 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
    
cleanup
Yuki Kimoto authored on 2011-04-02
195
    # Set process ID
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
196
    $self->pid($$);
197
    
packaging one directory
yuki-kimoto authored on 2009-11-16
198
    return $self;
199
}
200

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1125
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1126
}
1127

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1637
=head2 C<default_dbi_option>
1638

            
1639
    my $default_dbi_option = $dbi->default_dbi_option;
1640
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1641

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

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

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

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

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

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

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

            
1663
    my $models = $dbi->models;
1664
    $dbi       = $dbi->models(\%models);
1665

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1668
=head2 C<password>
1669

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

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

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

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

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

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

            
1684
     my reserved_word_quote = $dbi->reserved_word_quote;
1685
     $dbi                   = $dbi->reserved_word_quote('"');
1686

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1748
You can set multiple filters at once.
1749

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

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

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

            
1763
Create assign tag.
1764

            
1765
    title = {? title}, author = {? author}
1766

            
1767
This is equal to C<update_param_tag> exept that set is not added.
1768

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

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

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

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

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

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

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

            
1804
   $dbi->model('book')->select(...);
1805

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

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

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

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

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

            
1822
    my $dbh = $dbi->dbh;
1823

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

            
1827
=head2 C<each_column>
1828

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

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

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

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

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

            
1857
Tag is turned into the statement containing place holder
1858
before SQL is executed.
1859

            
1860
    select * from where title = ? and author like ?;
1861

            
1862
See also L<Tags/Tags>.
1863

            
1864
The following opitons are currently available.
1865

            
1866
=over 4
1867

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

            
1870
Table names for filtering.
1871

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

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

            
1877

            
1878

            
1879

            
1880

            
1881

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

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

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

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

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

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

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

            
1922
Delete statement.
1923

            
1924
The following opitons are currently available.
1925

            
update pod
Yuki Kimoto authored on 2011-03-13
1926
=over 4
1927

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

            
1930
Table name.
1931

            
1932
    $dbi->delete(table => 'book');
1933

            
1934
=item C<where>
1935

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

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

            
1957
Append statement to last of SQL. This is string.
1958

            
1959
    $dbi->delete(append => 'order by title');
1960

            
1961
=item C<filter>
1962

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

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

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

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

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

            
1996
Create column clause. The follwoing column clause is created.
1997

            
1998
    book.author as book__author,
1999
    book.title as book__title
2000

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

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

            
2006
    my $query = $dbi->delete(query => 1);
2007

            
2008
You can check SQL.
2009

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2012
=back
2013

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

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

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

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

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

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

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

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

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

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

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

            
2047
This is used to create where clause.
2048

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

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

            
2054
    # Constant value
2055
    $dbi->delete(where => 5);
2056

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

            
2060
In first examle, the following SQL is created.
2061

            
2062
    delete from book where id = ?;
2063

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2066
=back
2067

            
cleanup
yuki-kimoto authored on 2010-10-17
2068
=head2 C<insert>
2069

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

            
2075
Insert statement.
2076

            
2077
The following opitons are currently available.
2078

            
update pod
Yuki Kimoto authored on 2011-03-13
2079
=over 4
2080

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

            
2083
Table name.
2084

            
2085
    $dbi->insert(table => 'book');
2086

            
2087
=item C<param>
2088

            
2089
Insert data. This is hash reference.
2090

            
2091
    $dbi->insert(param => {title => 'Perl'});
2092

            
2093
=item C<append>
2094

            
2095
Append statement to last of SQL. This is string.
2096

            
2097
    $dbi->insert(append => 'order by title');
2098

            
2099
=item C<filter>
2100

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2141
=back
2142

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2158
=over 4
2159

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

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

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

            
2170
This is used to create parts of insert data.
2171

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

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

            
2177
    # Constant value
2178
    $dbi->insert(where => 5);
2179

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

            
2183
In first examle, the following SQL is created.
2184

            
2185
    insert into book (id, title) values (?, ?);
2186

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2189
=back
2190

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

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

            
2195
Create insert parameter tag.
2196

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2251
Merge paramters.
2252

            
2253
$param:
2254

            
2255
    {key1 => [1, 1], key2 => 2}
2256

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

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

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

            
2274
    $dbi->update_or_insert;
2275
    $dbi->find_or_create;
2276

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

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

            
2286
Set and get a L<DBIx::Custom::Model> object,
2287

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

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

            
2292
Create column clause for myself. The follwoing column clause is created.
2293

            
2294
    book.author as author,
2295
    book.title as title
2296

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

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

            
2306
Create a new L<DBIx::Custom> object.
2307

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

            
2310
    my $not_exists = $dbi->not_exists;
2311

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2315
=head2 C<register_filter>
2316

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2378
The following opitons are currently available.
2379

            
2380
=over 4
2381

            
2382
=item C<table>
2383

            
2384
Table name.
2385

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

            
2388
=item C<column>
2389

            
2390
Column clause. This is array reference or constant value.
2391

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

            
2398
Default is '*' unless C<column> is specified.
2399

            
2400
    # Default
2401
    $dbi->select(column => '*');
2402

            
2403
=item C<where>
2404

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

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

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

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

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

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

            
2448
In above select, the following SQL is created.
2449

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

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

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

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

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

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

            
2475
    $dbi->select(append => 'order by title');
2476

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

            
2479
Wrap statement. This is array reference.
2480

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

            
2483
This option is for Oracle and SQL Server paging process.
2484

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

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

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

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

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

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

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

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

            
2525
    my $sql = $query->sql;
2526

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

            
2529
Specify database data type.
2530

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

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

            
2536
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2537

            
update pod
Yuki Kimoto authored on 2011-03-12
2538
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2539

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2554
=over 4
2555

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

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

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

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

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

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

            
2573
    # Constant value
2574
    $dbi->select(where => 5);
2575

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

            
2579
In first examle, the following SQL is created.
2580

            
2581
    select * from book where id = ?
2582

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2585
=back
2586

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2599
=over 4
2600

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2603
Table name.
2604

            
2605
    $dbi->update(table => 'book');
2606

            
2607
=item C<param>
2608

            
2609
Update data. This is hash reference.
2610

            
2611
    $dbi->update(param => {title => 'Perl'});
2612

            
2613
=item C<where>
2614

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

            
2637
Append statement to last of SQL. This is string.
2638

            
2639
    $dbi->update(append => 'order by title');
2640

            
2641
=item C<filter>
2642

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

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

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

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

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

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

            
2679
You can check SQL.
2680

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2683
=back
2684

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2707
=over 4
2708

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

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

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

            
2719
This is used to create where clause.
2720

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

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

            
2726
    # Constant value
2727
    $dbi->update(where => 5);
2728

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

            
2732
In first examle, the following SQL is created.
2733

            
2734
    update book set title = ? where id = ?
2735

            
2736
Place holders are set to 'Perl' and 5.
2737

            
update pod
Yuki Kimoto authored on 2011-03-13
2738
=back
2739

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

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

            
2744
Create update parameter tag.
2745

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

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

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

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

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

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

            
2765
Create a new L<DBIx::Custom::Where> object.
2766

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2774
=head1 Tags
2775

            
2776
The following tags is available.
2777

            
2778
=head2 C<?>
2779

            
2780
Placeholder tag.
2781

            
2782
    {? NAME}    ->   ?
2783

            
2784
=head2 C<=>
2785

            
2786
Equal tag.
2787

            
2788
    {= NAME}    ->   NAME = ?
2789

            
2790
=head2 C<E<lt>E<gt>>
2791

            
2792
Not equal tag.
2793

            
2794
    {<> NAME}   ->   NAME <> ?
2795

            
2796
=head2 C<E<lt>>
2797

            
2798
Lower than tag
2799

            
2800
    {< NAME}    ->   NAME < ?
2801

            
2802
=head2 C<E<gt>>
2803

            
2804
Greater than tag
2805

            
2806
    {> NAME}    ->   NAME > ?
2807

            
2808
=head2 C<E<gt>=>
2809

            
2810
Greater than or equal tag
2811

            
2812
    {>= NAME}   ->   NAME >= ?
2813

            
2814
=head2 C<E<lt>=>
2815

            
2816
Lower than or equal tag
2817

            
2818
    {<= NAME}   ->   NAME <= ?
2819

            
2820
=head2 C<like>
2821

            
2822
Like tag
2823

            
2824
    {like NAME}   ->   NAME like ?
2825

            
2826
=head2 C<in>
2827

            
2828
In tag.
2829

            
2830
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2831

            
2832
=head2 C<insert_param>
2833

            
2834
Insert parameter tag.
2835

            
2836
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2837

            
2838
=head2 C<update_param>
2839

            
2840
Updata parameter tag.
2841

            
2842
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2843

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

            
2846
=head2 C<DBIX_CUSTOM_DEBUG>
2847

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

            
2851
=head2 C<DBIX_CUSTOM_DEBUG_ENCODING>
2852

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

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

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

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

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

            
2864
C<< <kimoto.yuki at gmail.com> >>
2865

            
2866
L<http://github.com/yuki-kimoto/DBIx-Custom>
2867

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2868
=head1 AUTHOR
2869

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

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

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

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

            
2879
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2880

            
2881