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

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
3
our $VERSION = '0.1656';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

            
packaging one directory
yuki-kimoto authored on 2009-11-16
11
use Carp 'croak';
12
use DBI;
13
use DBIx::Custom::Result;
cleanup
yuki-kimoto authored on 2010-02-11
14
use DBIx::Custom::Query;
cleanup
yuki-kimoto authored on 2010-08-05
15
use DBIx::Custom::QueryBuilder;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
16
use DBIx::Custom::Where;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
17
use DBIx::Custom::Model;
cleanup
Yuki Kimoto authored on 2011-01-25
18
use DBIx::Custom::Tag;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
19
use DBIx::Custom::Util;
update document
yuki-kimoto authored on 2010-05-27
20
use Encode qw/encode_utf8 decode_utf8/;
packaging one directory
yuki-kimoto authored on 2009-11-16
21

            
fix tests
Yuki Kimoto authored on 2011-01-13
22
__PACKAGE__->attr(
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
23
    [qw/data_source dbh password user/],
fix tests
Yuki Kimoto authored on 2011-01-13
24
    cache => 1,
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
25
    dbi_option => sub { {} },
26
    default_dbi_option => sub {{
27
        RaiseError => 1,
28
        PrintError => 0,
29
        AutoCommit => 1
30
    }},
add models() attribute
Yuki Kimoto authored on 2011-02-21
31
    models => sub { {} },
cleanup
Yuki Kimoto authored on 2011-01-23
32
    query_builder => sub { DBIx::Custom::QueryBuilder->new },
many changed
Yuki Kimoto authored on 2011-01-23
33
    result_class  => 'DBIx::Custom::Result',
update pod
Yuki Kimoto authored on 2011-02-07
34
    safety_column_name => sub { qr/^[\w\.]*$/ },
35
    stash => sub { {} }
many changed
Yuki Kimoto authored on 2011-01-23
36
);
37

            
38
__PACKAGE__->attr(
39
    cache_method => sub {
40
        sub {
41
            my $self = shift;
42
            
43
            $self->{_cached} ||= {};
44
            
45
            if (@_ > 1) {
46
                $self->{_cached}{$_[0]} = $_[1] 
47
            }
48
            else {
49
                return $self->{_cached}{$_[0]}
50
            }
51
        }
52
    }
53
);
54

            
55
__PACKAGE__->attr(
fix tests
Yuki Kimoto authored on 2011-01-13
56
    filters => sub {
57
        {
58
            encode_utf8 => sub { encode_utf8($_[0]) },
59
            decode_utf8 => sub { decode_utf8($_[0]) }
60
        }
many changed
Yuki Kimoto authored on 2011-01-23
61
    }
fix tests
Yuki Kimoto authored on 2011-01-13
62
);
cleanup
yuki-kimoto authored on 2010-10-17
63

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

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

            
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
71
    # Method
72
    $self->{_methods} ||= {};
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
73
    if (my $method = $self->{_methods}->{$mname}) {
74
        return $self->$method(@_)
75
    }
76
    elsif ($self->dbh->can($mname)) {
77
        $self->dbh->$mname(@_);
78
    }
79
    else {
80
        croak qq/Can't locate object method "$mname" via "$package"/
81
    }
added helper method
yuki-kimoto authored on 2010-10-17
82
}
83

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

            
87
    # Initialize filters
cleanup
Yuki Kimoto authored on 2011-01-12
88
    $self->{filter} ||= {};
many changed
Yuki Kimoto authored on 2011-01-23
89
    $self->{filter}{out} ||= {};
90
    $self->{filter}{in} ||= {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
91
    $self->{filter}{end} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-22
92
    
many changed
Yuki Kimoto authored on 2011-01-23
93
    # Create filters
94
    my $usage = "Usage: \$dbi->apply_filter(" .
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
95
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
96
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
many changed
Yuki Kimoto authored on 2011-01-23
97

            
98
    for (my $i = 0; $i < @cinfos; $i += 2) {
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
99
        
many changed
Yuki Kimoto authored on 2011-01-23
100
        # Column
101
        my $column = $cinfos[$i];
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
102
        
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
103
        if (ref $column eq 'ARRAY') {
104
            foreach my $c (@$column) {
105
                push @cinfos, $c, $cinfos[$i + 1];
106
            }
107
            next;
108
        }
109
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
110
        # Filter info
111
        my $finfo = $cinfos[$i + 1] || {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
112
        croak "$usage (table: $table)" unless  ref $finfo eq 'HASH';
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
113
        foreach my $ftype (keys %$finfo) {
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
114
            croak "$usage (table: $table 2)" unless $ftype eq 'in' || $ftype eq 'out'
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
115
                             || $ftype eq 'end'; 
many changed
Yuki Kimoto authored on 2011-01-23
116
        }
117
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
118
        foreach my $way (qw/in out end/) {
119
            my $filter = $finfo->{$way};
cleanup
Yuki Kimoto authored on 2010-12-22
120
            
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
121
            # State
122
            my $state = !exists $finfo->{$way} ? 'not_exists'
123
                      : !defined $filter        ? 'not_defined'
124
                      : ref $filter eq 'CODE'   ? 'code'
125
                      : 'name';
126
            
127
            next if $state eq 'not_exists';
128
            
129
            # Check filter
130
            croak qq{Filter "$filter" is not registered}
131
              if  $state eq 'name'
132
               && ! exists $self->filters->{$filter};
133
            
134
            # Filter
135
            my $f = $state eq 'not_defined' ? undef
136
                  : $state eq 'code'        ? $filter
137
                  : $self->filters->{$filter};
138
            $self->{filter}{$way}{$table}{$column} = $f;
139
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
140
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
141
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
142
    }
143
    
many changed
Yuki Kimoto authored on 2011-01-23
144
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
145
}
146

            
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
147
sub method {
added helper method
yuki-kimoto authored on 2010-10-17
148
    my $self = shift;
149
    
150
    # Merge
renamed helper to method.
Yuki Kimoto authored on 2011-01-25
151
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
152
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
added helper method
yuki-kimoto authored on 2010-10-17
153
    
154
    return $self;
155
}
156

            
packaging one directory
yuki-kimoto authored on 2009-11-16
157
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
158
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
159
    
many changed
Yuki Kimoto authored on 2011-01-23
160
    # Attributes
packaging one directory
yuki-kimoto authored on 2009-11-16
161
    my $data_source = $self->data_source;
many changed
Yuki Kimoto authored on 2011-01-23
162
    croak qq{"data_source" must be specified to connect()"}
check arguments of connect m...
Yuki Kimoto authored on 2010-12-20
163
      unless $data_source;
packaging one directory
yuki-kimoto authored on 2009-11-16
164
    my $user        = $self->user;
165
    my $password    = $self->password;
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
166
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
added dbi_options attribute
kimoto authored on 2010-12-20
167
    
update document
yuki-kimoto authored on 2010-01-30
168
    # Connect
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
169
    my $dbh = eval {DBI->connect(
packaging one directory
yuki-kimoto authored on 2009-11-16
170
        $data_source,
171
        $user,
172
        $password,
173
        {
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
174
            %{$self->default_dbi_option},
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
175
            %$dbi_option
packaging one directory
yuki-kimoto authored on 2009-11-16
176
        }
177
    )};
178
    
update document
yuki-kimoto authored on 2010-01-30
179
    # Connect error
packaging one directory
yuki-kimoto authored on 2009-11-16
180
    croak $@ if $@;
181
    
update document
yuki-kimoto authored on 2010-01-30
182
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
183
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
184
    
packaging one directory
yuki-kimoto authored on 2009-11-16
185
    return $self;
186
}
187

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

            
cleanup
yuki-kimoto authored on 2010-10-17
210
        # Create SQL object
211
        my $builder = $self->query_builder;
212
        
213
        # Create query
214
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
215

            
cleanup
yuki-kimoto authored on 2010-10-17
216
        # Cache query
217
        $self->cache_method->($self, $source,
218
                             {sql     => $query->sql, 
add table tag
Yuki Kimoto authored on 2011-02-09
219
                              columns => $query->columns,
220
                              tables  => $query->tables})
cleanup
yuki-kimoto authored on 2010-10-17
221
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
222
    }
223
    
cleanup
yuki-kimoto authored on 2010-10-17
224
    # Prepare statement handle
225
    my $sth;
226
    eval { $sth = $self->dbh->prepare($query->{sql})};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
227
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
228
    
cleanup
yuki-kimoto authored on 2010-10-17
229
    # Set statement handle
230
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
231
    
cleanup
Yuki Kimoto authored on 2011-02-09
232
    # Set filters
233
    $query->filters($self->filters);
234
    
cleanup
yuki-kimoto authored on 2010-10-17
235
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
236
}
237

            
cleanup
yuki-kimoto authored on 2010-10-17
238
our %VALID_DELETE_ARGS
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
239
  = map { $_ => 1 } qw/table where append filter allow_delete_all query/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
240

            
cleanup
yuki-kimoto authored on 2010-10-17
241
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
242
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
243
    
cleanup
Yuki Kimoto authored on 2011-03-09
244
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
245
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
246
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
247
          unless $VALID_DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
248
    }
249
    
250
    # Arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
251
    my $table            = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
252
    croak qq{"table" option must be specified} unless $table;
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
253
    my $where            = $args{where} || {};
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
254
    my $append           = $args{append};
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
255
    my $filter           = $args{filter};
cleanup
yuki-kimoto authored on 2010-10-17
256
    my $allow_delete_all = $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
257

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
258
    # Where
259
    my $w;
260
    if (ref $where eq 'HASH') {
261
        my $clause = ['and'];
262
        push @$clause, "{= $_}" for keys %$where;
263
        $w = $self->where;
264
        $w->clause($clause);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
265
        $w->param($where);
packaging one directory
yuki-kimoto authored on 2009-11-16
266
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
267
    elsif (ref $where eq 'DBIx::Custom::Where') {
268
        $w = $where;
269
        $where = $w->param;
270
    }    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
271
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
272
      unless ref $w eq 'DBIx::Custom::Where';
273
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
274
    # String where
275
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
276
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
277
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
278
      if $swhere eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
279

            
cleanup
Yuki Kimoto authored on 2011-01-27
280
    # SQL stack
281
    my @sql;
282

            
283
    # Delete
284
    push @sql, "delete from $table $swhere";
285
    push @sql, $append if $append;
286
    
287
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
288
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
289
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
290
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
291
    return $query if $args{query};
292
    
packaging one directory
yuki-kimoto authored on 2009-11-16
293
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
294
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
295
        $query, param  => $where, filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
296
        table => $table);
packaging one directory
yuki-kimoto authored on 2009-11-16
297
    
298
    return $ret_val;
299
}
300

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
303
our %VALID_DELETE_AT_ARGS
304
  = map { $_ => 1 } qw/table where append filter query
305
                       primary_key param/;
306

            
307
sub delete_at {
308
    my ($self, %args) = @_;
309
    
cleanup
Yuki Kimoto authored on 2011-03-09
310
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
311
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
312
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
313
          unless $VALID_DELETE_AT_ARGS{$name};
314
    }
315
    
316
    # Primary key
317
    my $primary_keys = delete $args{primary_key};
318
    $primary_keys = [$primary_keys] unless ref $primary_keys;
319
    
320
    # Where clause
321
    my $where = {};
322
    if (exists $args{where}) {
323
        my $where_columns = delete $args{where};
324
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
325

            
326
        croak qq{"where" must be constant value or array reference}
327
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
328
        
329
        for(my $i = 0; $i < @$primary_keys; $i ++) {
330
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
331
        }
332
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
333
    
334
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
335
        my $param = delete $args{param};
336
        
337
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
338
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
339
        }
340
    }
341
    
342
    return $self->delete(where => $where, %args);
343
}
344

            
added helper method
yuki-kimoto authored on 2010-10-17
345
sub DESTROY { }
346

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
347
our %VALID_EXECUTE_ARGS = map { $_ => 1 } qw/param filter table/;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
348

            
cleanup
yuki-kimoto authored on 2010-10-17
349
sub execute{
350
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
351
    
cleanup
Yuki Kimoto authored on 2011-03-09
352
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
353
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
354
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
355
          unless $VALID_EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
356
    }
357
    
cleanup
yuki-kimoto authored on 2010-10-17
358
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
359
    
cleanup
yuki-kimoto authored on 2010-10-17
360
    # First argument is the soruce of SQL
361
    $query = $self->create_query($query)
362
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
363
    
add table tag
Yuki Kimoto authored on 2011-02-09
364
    # Applied filter
cleanup
Yuki Kimoto authored on 2011-01-12
365
    my $filter = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
366
    
add table tag
Yuki Kimoto authored on 2011-02-09
367
    my $tables = $query->tables;
368
    my $arg_tables = $args{table} || [];
369
    $arg_tables = [$arg_tables]
370
      unless ref $arg_tables eq 'ARRAY';
371
    push @$tables, @$arg_tables;
cleanup
Yuki Kimoto authored on 2011-03-09
372

            
373
    # Organize tables
374
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
375
    my $main_table = pop @$tables;
376
    delete $table_set{$main_table} if $main_table;
377
    $tables = [keys %table_set];
378
    push @$tables, $main_table if $main_table;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
379
    
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
380
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
381
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
382
        $filter = {
383
            %$filter,
384
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
385
        }
386
    }
387
    
cleanup
Yuki Kimoto authored on 2011-01-12
388
    # Filter argument
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
389
    my $f = DBIx::Custom::Util::array_filter_to_hash($args{filter})
390
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
391
    foreach my $column (keys %$f) {
392
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
393
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
394
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
395
        }
396
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
397
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
398
            unless exists $self->filters->{$fname};
399
          
cleanup
Yuki Kimoto authored on 2011-01-12
400
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
401
        }
402
    }
cleanup
Yuki Kimoto authored on 2011-01-12
403
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
404
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
405
    # Bind
406
    my $bind = $self->_bind($params, $query->columns, $filter);
cleanup
yuki-kimoto authored on 2010-10-17
407
    
408
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
409
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
410
    my $affected;
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
411
    eval {$affected = $sth->execute(@$bind)};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
412
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
413
    
414
    # Return resultset if select statement is executed
415
    if ($sth->{NUM_OF_FIELDS}) {
416
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
417
        # Result in and end filter
418
        my $in_filter  = {};
419
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
420
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
421
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
422
            $in_filter = {
423
                %$in_filter,
424
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
425
            };
426
            $end_filter = {
427
                %$end_filter,
428
                %{$self->{filter}{end}{$table} || {}}
429
            };
cleanup
Yuki Kimoto authored on 2011-01-12
430
        }
431
        
432
        # Result
433
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
434
            sth            => $sth,
435
            filters        => $self->filters,
436
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
437
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
438
            filter         => $in_filter || {},
439
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
440
        );
441

            
442
        return $result;
443
    }
444
    return $affected;
445
}
446

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
447
our %VALID_INSERT_ARGS = map { $_ => 1 } qw/table param append
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
448
                                            filter query/;
cleanup
yuki-kimoto authored on 2010-10-17
449
sub insert {
450
    my ($self, %args) = @_;
451

            
cleanup
Yuki Kimoto authored on 2011-03-09
452
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
453
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
454
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
455
          unless $VALID_INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
456
    }
457
    
cleanup
yuki-kimoto authored on 2010-10-17
458
    # Arguments
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
459
    my $table  = $args{table};
460
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
461
    my $param  = $args{param} || {};
462
    my $append = $args{append} || '';
463
    my $filter = $args{filter};
464
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
465
    # Columns
466
    my @columns;
467
    my $safety = $self->safety_column_name;
468
    foreach my $column (keys %$param) {
469
        croak qq{"$column" is not safety column name}
470
          unless $column =~ /$safety/;
471
        push @columns, $column;
472
    }
cleanup
yuki-kimoto authored on 2010-10-17
473
    
cleanup
Yuki Kimoto authored on 2011-01-27
474
    # SQL stack
475
    my @sql;
476
    
477
    # Insert
478
    push @sql, "insert into $table {insert_param ". join(' ', @columns) . '}';
479
    push @sql, $append if $append;
480
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
481
    # SQL
cleanup
Yuki Kimoto authored on 2011-01-27
482
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
483
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
484
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
485
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
486
    return $query if $args{query};
487
    
packaging one directory
yuki-kimoto authored on 2009-11-16
488
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
489
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
490
        $query,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
491
        param  => $param,
492
        filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
493
        table => $table
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
494
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
495
    
496
    return $ret_val;
497
}
498

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
499
our %VALID_INSERT_AT_ARGS
500
  = map { $_ => 1 } qw/table param
501
                       where append filter query
502
                       primary_key param/;
503

            
504
sub insert_at {
505
    my ($self, %args) = @_;
506
    
cleanup
Yuki Kimoto authored on 2011-03-09
507
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
508
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
509
        croak qq{Argument "$name" is invalid name}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
510
          unless $VALID_INSERT_AT_ARGS{$name};
511
    }
512
    
513
    # Primary key
514
    my $primary_keys = delete $args{primary_key};
515
    $primary_keys = [$primary_keys] unless ref $primary_keys;
516
    
517
    # Where clause
518
    my $where = {};
519
    my $param = {};
520
    
521
    if (exists $args{where}) {
522
        my $where_columns = delete $args{where};
523
        $where_columns = [$where_columns] unless ref $where_columns;
524

            
525
        croak qq{"where" must be constant value or array reference}
526
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
527
        
528
        for(my $i = 0; $i < @$primary_keys; $i ++) {
529
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
530
        }
531
    }
532
    
533
    if (exists $args{param}) {
534
        $param = delete $args{param};
535
        for(my $i = 0; $i < @$primary_keys; $i ++) {
536
             delete $param->{$primary_keys->[$i]};
537
        }
538
    }
539
    
540
    $param = {%$param, %$where};
541
    
542
    return $self->insert(param => $param, %args);
543
}
544

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
545
sub insert_param {
546
    my ($self, $param) = @_;
547
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
548
    # Insert paramter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
549
    my @tag;
550
    push @tag, '{insert_param';
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
551
    my $safety = $self->safety_column_name;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
552
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
553
        croak qq{"$column" is not safety column name}
554
          unless $column =~ /$safety/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
555
        push @tag, $column;
556
    }
557
    push @tag, '}';
558
    
559
    return join ' ', @tag;
560
}
561

            
pod fix
Yuki Kimoto authored on 2011-01-21
562
sub each_column {
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
563
    my ($self, $cb) = @_;
564
    
565
    # Iterate all tables
566
    my $sth_tables = $self->dbh->table_info;
567
    while (my $table_info = $sth_tables->fetchrow_hashref) {
568
        
569
        # Table
570
        my $table = $table_info->{TABLE_NAME};
571
        
572
        # Iterate all columns
573
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
574
        while (my $column_info = $sth_columns->fetchrow_hashref) {
575
            my $column = $column_info->{COLUMN_NAME};
removed experimental txn_sco...
Yuki Kimoto authored on 2011-01-24
576
            $self->$cb($table, $column, $column_info);
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
577
        }
578
    }
579
}
580

            
added dbi_options attribute
kimoto authored on 2010-12-20
581
sub new {
582
    my $self = shift->SUPER::new(@_);
583
    
584
    # Check attribute names
585
    my @attrs = keys %$self;
586
    foreach my $attr (@attrs) {
587
        croak qq{"$attr" is invalid attribute name}
588
          unless $self->can($attr);
589
    }
cleanup
Yuki Kimoto authored on 2011-01-25
590

            
591
    $self->register_tag(
592
        '?'     => \&DBIx::Custom::Tag::placeholder,
593
        '='     => \&DBIx::Custom::Tag::equal,
594
        '<>'    => \&DBIx::Custom::Tag::not_equal,
595
        '>'     => \&DBIx::Custom::Tag::greater_than,
596
        '<'     => \&DBIx::Custom::Tag::lower_than,
597
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
598
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
599
        'like'  => \&DBIx::Custom::Tag::like,
600
        'in'    => \&DBIx::Custom::Tag::in,
601
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
602
        'update_param' => \&DBIx::Custom::Tag::update_param
603
    );
added dbi_options attribute
kimoto authored on 2010-12-20
604
    
605
    return $self;
606
}
607

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

            
cleanup
yuki-kimoto authored on 2010-10-17
610
sub register_filter {
611
    my $invocant = shift;
612
    
613
    # Register filter
614
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
615
    $invocant->filters({%{$invocant->filters}, %$filters});
616
    
617
    return $invocant;
618
}
packaging one directory
yuki-kimoto authored on 2009-11-16
619

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
622
our %VALID_SELECT_ARGS
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
623
  = map { $_ => 1 } qw/table column where append relation filter query selection join/;
624

            
625
sub _need_tables {
626
    my ($self, $tree, $need_tables, $tables) = @_;
627
    
628
    foreach my $table (@$tables) {
629
        
630
        if ($tree->{$table}) {
631
            $need_tables->{$table} = 1;
632
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
633
        }
634
    }
635
}
refactoring select
yuki-kimoto authored on 2010-04-28
636

            
packaging one directory
yuki-kimoto authored on 2009-11-16
637
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
638
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
639
    
cleanup
Yuki Kimoto authored on 2011-03-09
640
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
641
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
642
        croak qq{Argument "$name" is invalid name}
refactoring select
yuki-kimoto authored on 2010-04-28
643
          unless $VALID_SELECT_ARGS{$name};
644
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
645
    
refactoring select
yuki-kimoto authored on 2010-04-28
646
    # Arguments
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
647
    my $table = $args{table};
648
    my $tables = ref $table eq 'ARRAY' ? $table
649
               : defined $table ? [$table]
650
               : [];
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
651
    my $columns   = $args{column} || [];
select method column option ...
Yuki Kimoto authored on 2011-02-22
652
    $columns = [$columns] unless ref $columns;
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
653
    my $selection = $args{selection} || '';
654
    my $where     = $args{where} || {};
655
    my $append    = $args{append};
656
    my $filter    = $args{filter};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
657
    my $join =     $args{join} || [];
658
    croak qq{"join" must be array reference}
659
      unless ref $join eq 'ARRAY';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
660
    
cleanup
Yuki Kimoto authored on 2011-03-09
661
    # Add relation tables(DEPRECATED!);
662
    $self->_add_relation_table($tables, $args{relation});
packaging one directory
yuki-kimoto authored on 2009-11-16
663
    
cleanup
Yuki Kimoto authored on 2011-01-27
664
    # SQL stack
665
    my @sql;
666
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
667
    
cleanup
Yuki Kimoto authored on 2011-03-09
668
    # Selection
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
669
    if ($selection) { 
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
670
        push @sql, $selection;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
671
        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {
672
             unshift @$tables, $1;
673
        }
674
        unshift @$tables, @{$self->_tables($selection)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
675
    }
cleanup
Yuki Kimoto authored on 2011-03-09
676
    
677
    # Column names and table name
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
678
    else {
cleanup
Yuki Kimoto authored on 2011-03-09
679
        # Column names
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
680
        if (@$columns) {
681
            foreach my $column (@$columns) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
682
                unshift @$tables, @{$self->_tables($column)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
683
                push @sql, ($column, ',');
684
            }
685
            pop @sql if $sql[-1] eq ',';
686
        }
687
        else { push @sql, '*' }
688
        
689
        # Table
690
        push @sql, 'from';
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
691
        if ($args{relation}) {
692
            my $found = {};
693
            foreach my $table (@$tables) {
694
                push @sql, ($table, ',') unless $found->{$table};
695
                $found->{$table} = 1;
696
            }
packaging one directory
yuki-kimoto authored on 2009-11-16
697
        }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
698
        else { push @sql, $tables->[-1] }
699
        pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
700
    }
701
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
702
    # Main table
703
    croak "Not found table name" unless $tables->[-1];
704
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
705
    # Where
706
    my $w;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
707
    if (ref $where eq 'HASH') {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
708
        my $clause = ['and'];
709
        push @$clause, "{= $_}" for keys %$where;
cleanup
Yuki Kimoto authored on 2011-03-09
710
        $w = $self->where(clause => $clause, param => $where);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
711
    }
712
    elsif (ref $where eq 'DBIx::Custom::Where') {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
713
        $w = $where;
714
        $where = $w->param;
packaging one directory
yuki-kimoto authored on 2009-11-16
715
    }
716
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
717
    croak qq{"where" must be hash reference or DBIx::Custom::Where object}
718
      unless ref $w eq 'DBIx::Custom::Where';
719
    
720
    # String where
721
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
722
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
723
    # Add table names in where clause
724
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
725
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
726
    # Push join
727
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
728
    
cleanup
Yuki Kimoto authored on 2011-03-09
729
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
730
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
731
    
cleanup
Yuki Kimoto authored on 2011-03-08
732
    # Relation(DEPRECATED!);
733
    $self->_push_relation(\@sql, $tables, $args{relation}, $swhere eq '' ? 1 : 0);
734
    
cleanup
Yuki Kimoto authored on 2011-01-27
735
    # Append statement
736
    push @sql, $append if $append;
737
    
738
    # SQL
739
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
740
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
741
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
742
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
743
    return $query if $args{query};
744
    
packaging one directory
yuki-kimoto authored on 2009-11-16
745
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
746
    my $result = $self->execute(
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
747
        $query, param  => $where, filter => $filter,
748
        table => $tables);
packaging one directory
yuki-kimoto authored on 2009-11-16
749
    
750
    return $result;
751
}
752

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
753
our %VALID_SELECT_AT_ARGS
754
  = map { $_ => 1 } qw/table column where append relation filter query selection
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
755
                       param primary_key left_join/;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
756

            
757
sub select_at {
758
    my ($self, %args) = @_;
759
    
cleanup
Yuki Kimoto authored on 2011-03-09
760
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
761
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
762
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
763
          unless $VALID_SELECT_AT_ARGS{$name};
764
    }
765
    
766
    # Primary key
767
    my $primary_keys = delete $args{primary_key};
768
    $primary_keys = [$primary_keys] unless ref $primary_keys;
769
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
770
    # Table
771
    croak qq{"table" option must be specified} unless $args{table};
772
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
773
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
774
    # Where clause
775
    my $where = {};
776
    if (exists $args{where}) {
777
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
778
        
779
        croak qq{"where" must be constant value or array reference}
780
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
781
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
782
        $where_columns = [$where_columns] unless ref $where_columns;
783
        
784
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
785
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
786
        }
787
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
788
    
789
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
790
        my $param = delete $args{param};
791
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
792
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
793
        }
794
    }
795
    
796
    return $self->select(where => $where, %args);
797
}
798

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
799
sub model {
800
    my ($self, $name, $model) = @_;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
801
    
802
    # Set
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
803
    if ($model) {
add models() attribute
Yuki Kimoto authored on 2011-02-21
804
        $self->models->{$name} = $model;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
805
        return $self;
806
    }
807
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
808
    # Check model existance
809
    croak qq{Model "$name" is not included}
add models() attribute
Yuki Kimoto authored on 2011-02-21
810
      unless $self->models->{$name};
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
811
    
812
    # Get
add models() attribute
Yuki Kimoto authored on 2011-02-21
813
    return $self->models->{$name};
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
814
}
815

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
816
sub include_model {
817
    my ($self, $name_space, $model_infos) = @_;
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
818
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
819
    $name_space ||= '';
820
    unless ($model_infos) {
821
        # Load name space module
822
        croak qq{"$name_space" is invalid class name}
823
          if $name_space =~ /[^\w:]/;
824
        eval "use $name_space";
825
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
826
        
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
827
        # Search model modules
828
        my $path = $INC{"$name_space.pm"};
829
        $path =~ s/\.pm$//;
830
        opendir my $dh, $path
831
          or croak qq{Can't open directory "$path": $!};
832
        $model_infos = [];
833
        while (my $module = readdir $dh) {
834
            push @$model_infos, $module
835
              if $module =~ s/\.pm$//;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
836
        }
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
837
        
838
        close $dh;
839
    }
840
    
841
    foreach my $model_info (@$model_infos) {
842
        
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
843
        # Model class, name, table
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
844
        my $model_class;
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
845
        my $model_name;
846
        my $model_table;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
847
        if (ref $model_info eq 'HASH') {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
848
            $model_class = $model_info->{class};
849
            $model_name  = $model_info->{name};
850
            $model_table = $model_info->{table};
851
            
852
            $model_name  ||= $model_class;
853
            $model_table ||= $model_name;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
854
        }
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
855
        else { $model_class =$model_name = $model_table = $model_info }
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
856
        my $mclass = "${name_space}::$model_class";
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
857
        
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
858
        # Load
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
859
        croak qq{"$mclass" is invalid class name}
860
          if $mclass =~ /[^\w:]/;
861
        unless ($mclass->can('isa')) {
862
            eval "use $mclass";
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
863
            croak $@ if $@;
864
        }
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
865
        
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
866
        # Instantiate
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
867
        my $model = $mclass->new(dbi => $self);
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
868
        $model->name($model_name) unless $model->name;
869
        $model->table($model_table) unless $model->table;
removed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-28
870
        
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
871
        # Set
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
872
        $self->model($model->name, $model);
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
873
        
874
        # Apply filter
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
875
        croak "${name_space}::$model_class filter must be array reference"
876
          unless ref $model->filter eq 'ARRAY';
877
        $self->apply_filter($model->table, @{$model->filter});
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
878
    }
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
879
    return $self;
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
880
}
881

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
882
sub setup_model {
883
    my $self = shift;
884
    
885
    $self->each_column(
886
        sub {
887
            my ($self, $table, $column, $column_info) = @_;
888
            
889
            if (my $model = $self->models->{$table}) {
890
                push @{$model->columns}, $column;
891
            }
892
        }
893
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
894
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
895
}
896

            
cleanup
yuki-kimoto authored on 2010-10-17
897
our %VALID_UPDATE_ARGS
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
898
  = map { $_ => 1 } qw/table param
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
899
                       where append filter allow_update_all query/;
cleanup
yuki-kimoto authored on 2010-10-17
900

            
901
sub update {
902
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
903
    
cleanup
Yuki Kimoto authored on 2011-03-09
904
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
905
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
906
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
907
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
908
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
909
    
cleanup
yuki-kimoto authored on 2010-10-17
910
    # Arguments
911
    my $table            = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
912
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
913
    my $param            = $args{param} || {};
914
    my $where            = $args{where} || {};
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
915
    my $append           = $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
916
    my $filter           = $args{filter};
917
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
918
    
cleanup
yuki-kimoto authored on 2010-10-17
919
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
920
    my @clumns = keys %$param;
921

            
922
    # Columns
923
    my @columns;
924
    my $safety = $self->safety_column_name;
925
    foreach my $column (keys %$param) {
926
        croak qq{"$column" is not safety column name}
927
          unless $column =~ /$safety/;
928
        push @columns, $column;
929
    }
930
        
cleanup
yuki-kimoto authored on 2010-10-17
931
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
932
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
933

            
934
    # Where
935
    my $w;
936
    if (ref $where eq 'HASH') {
937
        my $clause = ['and'];
938
        push @$clause, "{= $_}" for keys %$where;
939
        $w = $self->where;
940
        $w->clause($clause);
941
        $w->param($where);
942
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
943
    elsif (ref $where eq 'DBIx::Custom::Where') {
944
        $w = $where;
945
        $where = $w->param;
946
    }  
removed experimental registe...
yuki-kimoto authored on 2010-08-24
947
    
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
948
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
949
      unless ref $w eq 'DBIx::Custom::Where';
removed reconnect method
yuki-kimoto authored on 2010-05-28
950
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
951
    # String where
952
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
953
    
954
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
955
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
956
    
cleanup
Yuki Kimoto authored on 2011-01-27
957
    # SQL stack
958
    my @sql;
959
    
960
    # Update
961
    push @sql, "update $table $update_clause $swhere";
962
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
963
    
cleanup
yuki-kimoto authored on 2010-10-17
964
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
965
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
966
        
cleanup
yuki-kimoto authored on 2010-10-17
967
        if (exists $param->{$wkey}) {
968
            $param->{$wkey} = [$param->{$wkey}]
969
              unless ref $param->{$wkey} eq 'ARRAY';
970
            
971
            push @{$param->{$wkey}}, $where->{$wkey};
972
        }
973
        else {
974
            $param->{$wkey} = $where->{$wkey};
975
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
976
    }
cleanup
yuki-kimoto authored on 2010-10-17
977
    
cleanup
Yuki Kimoto authored on 2011-01-27
978
    # SQL
979
    my $sql = join(' ', @sql);
980
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
981
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
982
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
983
    return $query if $args{query};
984
    
cleanup
yuki-kimoto authored on 2010-10-17
985
    # Execute query
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
986
    my $ret_val = $self->execute($query, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
987
                                 filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
988
                                 table => $table);
cleanup
yuki-kimoto authored on 2010-10-17
989
    
990
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
991
}
992

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
995
our %VALID_UPDATE_AT_ARGS
996
  = map { $_ => 1 } qw/table param
997
                       where append filter query
998
                       primary_key param/;
999

            
1000
sub update_at {
1001
    my ($self, %args) = @_;
1002
    
cleanup
Yuki Kimoto authored on 2011-03-09
1003
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1004
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1005
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1006
          unless $VALID_UPDATE_AT_ARGS{$name};
1007
    }
1008
    
1009
    # Primary key
1010
    my $primary_keys = delete $args{primary_key};
1011
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1012
    
1013
    # Where clause
1014
    my $where = {};
1015
    my $param = {};
1016
    
1017
    if (exists $args{where}) {
1018
        my $where_columns = delete $args{where};
1019
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1020

            
1021
        croak qq{"where" must be constant value or array reference}
1022
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1023
        
1024
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1025
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1026
        }
1027
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1028
    
1029
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1030
        $param = delete $args{param};
1031
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1032
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1033
        }
1034
    }
1035
    
1036
    return $self->update(where => $where, param => $param, %args);
1037
}
1038

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1039
sub update_param {
1040
    my ($self, $param) = @_;
1041
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1042
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1043
    my @tag;
1044
    push @tag, '{update_param';
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1045
    my $safety = $self->safety_column_name;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1046
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1047
        croak qq{"$column" is not safety column name}
1048
          unless $column =~ /$safety/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1049
        push @tag, $column;
1050
    }
1051
    push @tag, '}';
1052
    
1053
    return join ' ', @tag;
1054
}
1055

            
cleanup
Yuki Kimoto authored on 2011-01-25
1056
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1057
    my $self = shift;
1058

            
1059
    return DBIx::Custom::Where->new(
1060
        query_builder => $self->query_builder,
cleanup
Yuki Kimoto authored on 2011-03-09
1061
        safety_column_name => $self->safety_column_name,
1062
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1063
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1064
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1065

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1066
sub _bind {
cleanup
Yuki Kimoto authored on 2011-01-12
1067
    my ($self, $params, $columns, $filter) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1068
    
cleanup
Yuki Kimoto authored on 2011-01-12
1069
    # bind values
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1070
    my @bind;
add tests
yuki-kimoto authored on 2010-08-08
1071
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1072
    # Build bind values
1073
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1074
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1075
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1076
        
1077
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1078
        my $value;
1079
        if(ref $params->{$column} eq 'ARRAY') {
1080
            my $i = $count->{$column} || 0;
1081
            $i += $not_exists->{$column} || 0;
1082
            my $found;
1083
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1084
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1085
                    $not_exists->{$column}++;
1086
                }
1087
                else  {
1088
                    $value = $params->{$column}->[$k];
1089
                    $found = 1;
1090
                    last
1091
                }
1092
            }
1093
            next unless $found;
1094
        }
1095
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1096
        
cleanup
Yuki Kimoto authored on 2011-01-12
1097
        # Filter
1098
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1099
        
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1100
        push @bind, $f ? $f->($value) : $value;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1101
        
1102
        # Count up 
1103
        $count->{$column}++;
1104
    }
1105
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1106
    return \@bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1107
}
1108

            
cleanup
yuki-kimoto authored on 2010-10-17
1109
sub _croak {
1110
    my ($self, $error, $append) = @_;
1111
    $append ||= "";
1112
    
1113
    # Verbose
1114
    if ($Carp::Verbose) { croak $error }
1115
    
1116
    # Not verbose
1117
    else {
1118
        
1119
        # Remove line and module infromation
1120
        my $at_pos = rindex($error, ' at ');
1121
        $error = substr($error, 0, $at_pos);
1122
        $error =~ s/\s+$//;
1123
        
1124
        croak "$error$append";
1125
    }
1126
}
1127

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1128
sub _tables {
1129
    my ($self, $source) = @_;
1130
    
1131
    my $tables = [];
1132
    
1133
    my $safety_name = $self->safety_column_name;
1134
    
1135
    while ($source =~ /\b(\w+)\./g) {
1136
        push @$tables, $1;
1137
    }
1138
    
1139
    return $tables;
1140
}
1141

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1142
sub _push_join {
1143
    my ($self, $sql, $join, $join_tables) = @_;
1144
    
1145
    return unless @$join;
1146
    
1147
    my $tree = {};
1148
    
1149
    for (my $i = 0; $i < @$join; $i++) {
1150
        
1151
        my $join_clause = $join->[$i];
1152
        
1153
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\./) {
1154
            
1155
            my $table1 = $1;
1156
            my $table2 = $2;
1157
            
1158
            croak qq{right side table of "$join_clause" must be uniq}
1159
              if exists $tree->{$table2};
1160
            
1161
            $tree->{$table2}
1162
              = {position => $i, parent => $table1, join => $join_clause};
1163
        }
1164
        else {
1165
            croak qq{join "$join_clause" must be two table name};
1166
        }
1167
    }
1168
    
1169
    my $need_tables = {};
1170
    $self->_need_tables($tree, $need_tables, $join_tables);
1171
    
1172
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1173

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1174
    foreach my $need_table (@need_tables) {
1175
        push @$sql, $tree->{$need_table}{join};
1176
    }
1177
}
cleanup
Yuki Kimoto authored on 2011-03-08
1178

            
cleanup
Yuki Kimoto authored on 2011-01-25
1179
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1180
__PACKAGE__->attr(
1181
    dbi_options => sub { {} },
1182
    filter_check  => 1
1183
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1184

            
cleanup
Yuki Kimoto authored on 2011-01-25
1185
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1186
sub default_bind_filter {
1187
    my $self = shift;
1188
    
1189
    if (@_) {
1190
        my $fname = $_[0];
1191
        
1192
        if (@_ && !$fname) {
1193
            $self->{default_out_filter} = undef;
1194
        }
1195
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1196
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1197
              unless exists $self->filters->{$fname};
1198
        
1199
            $self->{default_out_filter} = $self->filters->{$fname};
1200
        }
1201
        return $self;
1202
    }
1203
    
1204
    return $self->{default_out_filter};
1205
}
1206

            
cleanup
Yuki Kimoto authored on 2011-01-25
1207
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1208
sub default_fetch_filter {
1209
    my $self = shift;
1210
    
1211
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1212
        my $fname = $_[0];
1213

            
cleanup
Yuki Kimoto authored on 2011-01-12
1214
        if (@_ && !$fname) {
1215
            $self->{default_in_filter} = undef;
1216
        }
1217
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1218
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1219
              unless exists $self->filters->{$fname};
1220
        
1221
            $self->{default_in_filter} = $self->filters->{$fname};
1222
        }
1223
        
1224
        return $self;
1225
    }
1226
    
many changed
Yuki Kimoto authored on 2011-01-23
1227
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1228
}
1229

            
cleanup
Yuki Kimoto authored on 2011-01-25
1230
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1231
sub register_tag_processor {
1232
    return shift->query_builder->register_tag_processor(@_);
1233
}
1234

            
cleanup
Yuki Kimoto authored on 2011-03-08
1235
# DEPRECATED!
1236
sub _push_relation {
1237
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1238
    
1239
    if (keys %{$relation || {}}) {
1240
        push @$sql, $need_where ? 'where' : 'and';
1241
        foreach my $rcolumn (keys %$relation) {
1242
            my $table1 = (split (/\./, $rcolumn))[0];
1243
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1244
            push @$tables, ($table1, $table2);
1245
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1246
        }
1247
    }
1248
    pop @$sql if $sql->[-1] eq 'and';    
1249
}
1250

            
1251
# DEPRECATED!
1252
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1253
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1254
    
1255
    if (keys %{$relation || {}}) {
1256
        foreach my $rcolumn (keys %$relation) {
1257
            my $table1 = (split (/\./, $rcolumn))[0];
1258
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1259
            my $table1_exists;
1260
            my $table2_exists;
1261
            foreach my $table (@$tables) {
1262
                $table1_exists = 1 if $table eq $table1;
1263
                $table2_exists = 1 if $table eq $table2;
1264
            }
1265
            unshift @$tables, $table1 unless $table1_exists;
1266
            unshift @$tables, $table2 unless $table2_exists;
1267
        }
1268
    }
1269
}
1270

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1273
=head1 NAME
1274

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1275
DBIx::Custom - DBI interface, having hash parameter binding and filtering system
removed reconnect method
yuki-kimoto authored on 2010-05-28
1276

            
1277
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1278

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1279
    use DBIx::Custom;
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1280
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1281
                                    user => 'ken', password => '!LFKD%$&',
1282
                                    dbi_option => {mysql_enable_utf8 => 1});
cleanup
yuki-kimoto authored on 2010-08-05
1283

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1284
    # Insert 
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1285
    $dbi->insert(table  => 'book',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1286
                 param  => {title => 'Perl', author => 'Ken'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1287
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1288
    
1289
    # Update 
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1290
    $dbi->update(table  => 'book', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1291
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
1292
                 where  => {id => 5},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1293
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1294
    
1295
    # Update all
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1296
    $dbi->update_all(table  => 'book',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1297
                     param  => {title => 'Perl'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1298
                     filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1299
    
1300
    # Delete
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1301
    $dbi->delete(table  => 'book',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1302
                 where  => {author => 'Ken'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1303
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1304
    
1305
    # Delete all
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1306
    $dbi->delete_all(table => 'book');
cleanup
yuki-kimoto authored on 2010-08-05
1307

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1308
    # Select
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
1309
    my $result = $dbi->select(
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1310
        table  => 'book',
update document
yuki-kimoto authored on 2010-05-27
1311
        column => [qw/author title/],
1312
        where  => {author => 'Ken'},
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1313
        relation => {'book.id' => 'rental.book_id'},
updated document
yuki-kimoto authored on 2010-08-08
1314
        append => 'order by id limit 5',
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1315
        filter => [title => 'to_something']
added commit method
yuki-kimoto authored on 2010-05-27
1316
    );
cleanup
yuki-kimoto authored on 2010-08-05
1317

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1318
    # Execute SQL
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1319
    $dbi->execute("select title from book");
removed register_format()
yuki-kimoto authored on 2010-05-26
1320
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1321
    # Execute SQL with hash binding and filtering
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1322
    $dbi->execute("select id from book where {= author} and {like title}",
removed register_format()
yuki-kimoto authored on 2010-05-26
1323
                  param  => {author => 'ken', title => '%Perl%'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1324
                  filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1325

            
1326
    # Create query and execute it
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1327
    my $query = $dbi->create_query(
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1328
        "select id from book where {= author} and {like title}"
removed reconnect method
yuki-kimoto authored on 2010-05-28
1329
    );
updated document
yuki-kimoto authored on 2010-08-08
1330
    $dbi->execute($query, param => {author => 'Ken', title => '%Perl%'})
cleanup
yuki-kimoto authored on 2010-08-05
1331

            
1332
    # Get DBI object
1333
    my $dbh = $dbi->dbh;
1334

            
removed register_format()
yuki-kimoto authored on 2010-05-26
1335
    # Fetch
1336
    while (my $row = $result->fetch) {
1337
        # ...
1338
    }
1339
    
1340
    # Fetch hash
1341
    while (my $row = $result->fetch_hash) {
1342
        
1343
    }
1344
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1345
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1346

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1347
L<DBIx::Custom> is one of L<DBI> interface modules,
1348
such as L<DBIx::Class>, L<DBIx::Simple>.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1349

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1350
This module is not O/R mapper. O/R mapper is useful,
1351
but you must learn many syntax of the O/R mapper,
updated document
yuki-kimoto authored on 2010-08-08
1352
which is almost another language.
1353
Created SQL statement is offten not effcient and damage SQL performance.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1354
so you have to execute raw SQL in the end.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1355

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1356
L<DBIx::Custom> is middle area between L<DBI> and O/R mapper.
updated document
yuki-kimoto authored on 2010-08-08
1357
L<DBIx::Custom> provide flexible hash parameter binding and filtering system,
added experimental expand me...
yuki-kimoto authored on 2010-10-20
1358
and suger methods, such as C<insert()>, C<update()>, C<delete()>, C<select()>
updated document
yuki-kimoto authored on 2010-08-08
1359
to execute SQL easily.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1360

            
updated document
yuki-kimoto authored on 2010-08-08
1361
L<DBIx::Custom> respects SQL. SQL is very complex and not beautiful,
1362
but de-facto standard,
1363
so all people learing database know it.
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1364
If you already know SQL,
1365
you learn a little thing to use L<DBIx::Custom>.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1366

            
pod fix
Yuki Kimoto authored on 2011-01-21
1367
See L<DBIx::Custom::Guide> for more details.
1368

            
1369
=head1 GUIDE
1370

            
1371
L<DBIx::Custom::Guide> - L<DBIx::Custom> complete guide
1372

            
1373
=head1 EXAMPLES
1374

            
1375
L<DBIx::Custom Wiki|https://github.com/yuki-kimoto/DBIx-Custom/wiki> - Many useful examples
updated document
yuki-kimoto authored on 2010-08-08
1376

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1379
=head2 C<cache>
packaging one directory
yuki-kimoto authored on 2009-11-16
1380

            
cleanup
yuki-kimoto authored on 2010-10-17
1381
    my $cache = $dbi->cache;
1382
    $dbi      = $dbi->cache(1);
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1383

            
cleanup
yuki-kimoto authored on 2010-10-17
1384
Enable parsed L<DBIx::Custom::Query> object caching.
1385
Default to 1.
packaging one directory
yuki-kimoto authored on 2009-11-16
1386

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

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

            
cleanup
yuki-kimoto authored on 2010-08-05
1392
Data source.
1393
C<connect()> method use this value to connect the database.
removed DESTROY method(not b...
yuki-kimoto authored on 2010-07-18
1394

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

            
cleanup
yuki-kimoto authored on 2010-08-03
1397
    my $dbh = $dbi->dbh;
1398
    $dbi    = $dbi->dbh($dbh);
packaging one directory
yuki-kimoto authored on 2009-11-16
1399

            
cleanup
yuki-kimoto authored on 2010-08-05
1400
L<DBI> object. You can call all methods of L<DBI>.
packaging one directory
yuki-kimoto authored on 2009-11-16
1401

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

            
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1404
    my $dbi_option = $dbi->dbi_option;
1405
    $dbi            = $dbi->dbi_option($dbi_option);
added dbi_options attribute
kimoto authored on 2010-12-20
1406

            
1407
DBI options.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1408

            
1409
Each option specified can ovewrite C<default_dbi_option>.
1410

            
1411
C<connect()> method use this value to connect the database.
1412

            
1413

            
1414
=head2 C<default_dbi_option>
1415

            
1416
    my $default_dbi_option = $dbi->default_dbi_option;
1417
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1418

            
1419
DBI default options.
1420

            
1421
    RaiseError => 1,
1422
    PrintError => 0,
1423
    AutoCommit => 1,
1424

            
added dbi_options attribute
kimoto authored on 2010-12-20
1425
C<connect()> method use this value to connect the database.
1426

            
cleanup
yuki-kimoto authored on 2010-08-05
1427
Default filter when row is fetched.
packaging one directory
yuki-kimoto authored on 2009-11-16
1428

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

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

            
add models() attribute
Yuki Kimoto authored on 2011-02-21
1434
Filters
1435

            
1436
=head2 C<(experimental) models>
1437

            
1438
    my $models = $dbi->models;
1439
    $dbi       = $dbi->models(\%models);
1440

            
1441
Models
1442

            
cleanup
yuki-kimoto authored on 2010-10-17
1443
=head2 C<password>
1444

            
1445
    my $password = $dbi->password;
1446
    $dbi         = $dbi->password('lkj&le`@s');
1447

            
1448
Password.
1449
C<connect()> method use this value to connect the database.
update document
yuki-kimoto authored on 2010-01-30
1450

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

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

            
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1456
SQL builder. C<query_builder()> must be 
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1457
the instance of L<DBIx::Custom::QueryBuilder> subclass.
1458
Default to L<DBIx::Custom::QueryBuilder> object.
cleanup
yuki-kimoto authored on 2010-08-05
1459

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1465
Result class for select statement.
1466
Default to L<DBIx::Custom::Result>.
cleanup
yuki-kimoto authored on 2010-08-05
1467

            
update pod
Yuki Kimoto authored on 2011-01-27
1468
=head2 C<(experimental) safety_column_name>
1469

            
1470
    my $safety_column_name = $self->safety_column_name;
1471
    $dbi                   = $self->safety_column_name($name);
1472

            
1473
Safety column name regex.
1474
Default is qr/^[\w\.]*$/
1475

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1478
    my $user = $dbi->user;
1479
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1480

            
cleanup
yuki-kimoto authored on 2010-10-17
1481
User name.
1482
C<connect()> method use this value to connect the database.
update pod
Yuki Kimoto authored on 2011-01-27
1483

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1486
L<DBIx::Custom> inherits all methods from L<Object::Simple>
autoload DBI method
Yuki Kimoto authored on 2011-01-26
1487
and use all method of L<DBI>
cleanup
yuki-kimoto authored on 2010-10-17
1488
and implements the following new ones.
added check_filter attribute
yuki-kimoto authored on 2010-08-08
1489

            
cleanup
Yuki Kimoto authored on 2011-01-25
1490
=head2 C<(experimental) apply_filter>
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1491

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1492
    $dbi->apply_filter(
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1493
        $table,
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1494
        $column1 => {in => $infilter1, out => $outfilter1, end => $endfilter1}
1495
        $column2 => {in => $infilter2, out => $outfilter2, end =. $endfilter2}
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1496
        ...,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1497
    );
1498

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1499
C<apply_filter> is automatically filter for columns of table.
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1500
This have effect C<insert>, C<update>, C<delete>. C<select>
cleanup
Yuki Kimoto authored on 2010-12-21
1501
and L<DBIx::Custom::Result> object. but this has'nt C<execute> method.
1502

            
cleanup
Yuki Kimoto authored on 2011-01-12
1503
If you want to have effect C<execute()> method, use C<table>
cleanup
Yuki Kimoto authored on 2010-12-21
1504
arguments.
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1505

            
cleanup
Yuki Kimoto authored on 2010-12-21
1506
    $result = $dbi->execute(
1507
        "select * from table1 where {= key1} and {= key2};",
1508
         param => {key1 => 1, key2 => 2},
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1509
         table => ['table1']
cleanup
Yuki Kimoto authored on 2010-12-21
1510
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1511

            
1512
You can use three name as column name.
1513

            
1514
    1. column        : author
1515
    2. table.column  : book.author
1516
    3. table__column : book__author
1517

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

            
cleanup
yuki-kimoto authored on 2010-08-05
1520
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
update document
yuki-kimoto authored on 2010-05-27
1521
                                    user => 'ken', password => '!LFKD%$&');
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1522

            
cleanup
yuki-kimoto authored on 2010-08-05
1523
Create a new L<DBIx::Custom> object and connect to the database.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1524
L<DBIx::Custom> is a wrapper of L<DBI>.
cleanup
yuki-kimoto authored on 2010-08-09
1525
C<AutoCommit> and C<RaiseError> options are true, 
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1526
and C<PrintError> option is false by default. 
packaging one directory
yuki-kimoto authored on 2009-11-16
1527

            
cleanup
yuki-kimoto authored on 2010-10-17
1528
=head2 C<create_query>
1529
    
1530
    my $query = $dbi->create_query(
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1531
        "select * from book where {= author} and {like title};"
cleanup
yuki-kimoto authored on 2010-10-17
1532
    );
update document
yuki-kimoto authored on 2009-11-19
1533

            
cleanup
yuki-kimoto authored on 2010-10-17
1534
Create the instance of L<DBIx::Custom::Query> from the source of SQL.
1535
If you want to get high performance,
1536
use C<create_query()> method and execute it by C<execute()> method
1537
instead of suger methods.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1538

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

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

            
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1543
    my $result = $dbi->execute($query,  param => $params, filter => \@filter);
1544
    my $result = $dbi->execute($source, param => $params, filter => \@filter);
update document
yuki-kimoto authored on 2009-11-19
1545

            
cleanup
yuki-kimoto authored on 2010-10-17
1546
Execute query or the source of SQL.
1547
Query is L<DBIx::Custom::Query> object.
1548
Return value is L<DBIx::Custom::Result> if select statement is executed,
1549
or the count of affected rows if insert, update, delete statement is executed.
version 0.0901
yuki-kimoto authored on 2009-12-17
1550

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

            
cleanup
yuki-kimoto authored on 2010-08-05
1553
    $dbi->delete(table  => $table,
1554
                 where  => \%where,
1555
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1556
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1557
                 query  => 1);
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1558

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1559
Execute delete statement.
1560
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
1561
C<table> is a table name.
1562
C<where> is where clause. this must be hash reference.
1563
C<append> is a string added at the end of the SQL statement.
1564
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1565
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1566
default to 0. This is experimental.
cleanup
yuki-kimoto authored on 2010-08-09
1567
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1568

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

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1573
Execute delete statement to delete all rows.
1574
Arguments is same as C<delete> method,
1575
except that C<delete_all> don't have C<where> argument.
cleanup
yuki-kimoto authored on 2010-08-09
1576
Return value of C<delete_all()> is the count of affected rows.
bind_filter argument is chan...
yuki-kimoto authored on 2009-11-19
1577

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1578
=head3 C<(experimental) delete_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1579

            
1580
To delete row by using primary key, use C<delete_at()>
1581

            
1582
    $dbi->delete_at(
1583
        table => 'book',
1584
        primary_key => ['id'],
1585
        where => ['123']
1586
    );
1587

            
1588
In this example, row which id column is 123 is deleted.
1589
NOTE that you must pass array reference as C<where>.
1590

            
1591
You can also write arguments like this.
1592

            
1593
    $dbi->delete_at(
1594
        table => 'book',
1595
        primary_key => ['id'],
1596
        param => {id => '123'}
1597
    );
1598

            
cleanup
yuki-kimoto authored on 2010-10-17
1599
=head2 C<insert>
1600

            
1601
    $dbi->insert(table  => $table, 
1602
                 param  => \%param,
1603
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1604
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1605
                 query  => 1);
cleanup
yuki-kimoto authored on 2010-10-17
1606

            
1607
Execute insert statement.
1608
C<insert> method have C<table>, C<param>, C<append>
1609
and C<filter> arguments.
1610
C<table> is a table name.
1611
C<param> is the pairs of column name value. this must be hash reference.
1612
C<append> is a string added at the end of the SQL statement.
1613
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1614
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1615
default to 0. This is experimental.
cleanup
yuki-kimoto authored on 2010-10-17
1616
This is overwrites C<default_bind_filter>.
1617
Return value of C<insert()> is the count of affected rows.
1618

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1619
=head3 C<(experimental) insert_at()>
1620

            
1621
To insert row by using primary key, use C<insert_at()>
1622

            
1623
    $dbi->insert_at(
1624
        table => 'book',
1625
        primary_key => ['id'],
1626
        where => ['123'],
1627
        param => {name => 'Ken'}
1628
    );
1629

            
1630
In this example, row which id column is 123 is inserted.
1631
NOTE that you must pass array reference as C<where>.
1632
If C<param> contains primary key,
1633
the key and value is delete from C<param>.
1634

            
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1635
=head2 C<(experimental) insert_param>
1636

            
1637
    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
1638

            
1639
Create insert parameter tag.
1640

            
1641
    {title => 'a', age => 2}   ->   {insert_param title age}
1642

            
pod fix
Yuki Kimoto authored on 2011-01-21
1643
=head2 C<(experimental) each_column>
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1644

            
pod fix
Yuki Kimoto authored on 2011-01-21
1645
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1646
        sub {
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1647
            my ($self, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1648
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1649
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
1650
            
1651
            if ($type eq 'DATE') {
1652
                # ...
1653
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1654
        }
1655
    );
pod fix
Yuki Kimoto authored on 2011-01-21
1656
Get column informations from database.
1657
Argument is callback.
1658
You can do anything in callback.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1659
Callback receive four arguments, dbi object, table name,
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1660
column name and column information.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1661

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1662
=head2 C<(experimental) include_model>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1663

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1664
    $dbi->include_model(
1665
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1666
            'book', 'person', 'company'
1667
        ]
1668
    );
1669

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1670
Include models. First argument is name space.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1671
Second argument is array reference of class base names.
1672

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1673
If you don't specify second argument, All models under name space is
1674
included.
1675

            
1676
    $dbi->include_model('MyModel');
1677

            
1678
Note that in this case name spece module is needed.
1679

            
1680
    # MyModel.pm
1681
    package MyModel;
1682
    
1683
    use base 'DBIx::Custom::Model';
1684

            
1685
The following model is instantiated and included.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1686

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1687
    MyModel::book
1688
    MyModel::person
1689
    MyModel::company
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1690

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1691
You can get these instance by C<model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1692

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1693
    my $book_model = $dbi->model('book');
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1694

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1695
If you want to other name as model class,
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1696
you can do like this.
1697

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1698
    $dbi->include_model(
1699
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1700
            {'book' => 'Book'},
1701
            {'person' => 'Person'}
1702
        ]
1703
    );
1704

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1705
=head2 C<(experimental) method>
1706

            
1707
    $dbi->method(
1708
        update_or_insert => sub {
1709
            my $self = shift;
1710
            # do something
1711
        },
1712
        find_or_create   => sub {
1713
            my $self = shift;
1714
            # do something
1715
        }
1716
    );
1717

            
1718
Register method. These method is called from L<DBIx::Custom> object directory.
1719

            
1720
    $dbi->update_or_insert;
1721
    $dbi->find_or_create;
1722

            
1723
=head2 C<new>
1724

            
1725
    my $dbi = DBIx::Custom->connect(data_source => "dbi:mysql:database=dbname",
1726
                                    user => 'ken', password => '!LFKD%$&');
1727

            
1728
Create a new L<DBIx::Custom> object.
1729

            
1730
=head2 C<(experimental) not_exists>
1731

            
1732
    my $not_exists = $dbi->not_exists;
1733

            
1734
Get DBIx::Custom::NotExists object.
experimental extended select...
Yuki Kimoto authored on 2011-01-17
1735

            
cleanup
yuki-kimoto authored on 2010-10-17
1736
=head2 C<register_filter>
1737

            
1738
    $dbi->register_filter(%filters);
1739
    $dbi->register_filter(\%filters);
1740
    
1741
Register filter. Registered filters is available in the following attributes
1742
or arguments.
1743

            
1744
=over 4
1745

            
1746
=item *
1747

            
1748
C<filter> argument of C<insert()>, C<update()>,
1749
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1750
methods
1751

            
1752
=item *
1753

            
1754
C<execute()> method
1755

            
1756
=item *
1757

            
1758
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1759

            
1760
=item *
1761

            
1762
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1763

            
1764
=back
1765

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1766
=head2 C<register_tag>
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1767

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1768
    $dbi->register_tag(
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1769
        limit => sub {
1770
            ...;
1771
        }
1772
    );
1773

            
cleanup
Yuki Kimoto authored on 2011-01-25
1774
Register tag.
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1775

            
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1776
=head2 C<rollback>
cleanup
yuki-kimoto authored on 2010-10-17
1777

            
1778
    $dbi->rollback;
1779

            
1780
Rollback transaction.
1781
This is same as L<DBI>'s C<rollback>.
1782

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1783
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1784
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
1785
    my $result = $dbi->select(
1786
        table     => $table,
1787
        column    => [@column],
1788
        where     => \%where,
1789
        append    => $append,
1790
        relation  => \%relation,
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
1791
        join => ['left outer join company on book.company_id = company.id']
select method column option ...
Yuki Kimoto authored on 2011-02-22
1792
        filter    => \%filter,
1793
        query     => 1,
1794
        selection => $selection
1795
    );
update document
yuki-kimoto authored on 2009-11-19
1796

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1797
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1798
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1799
C<relation> and C<filter> arguments.
1800
C<table> is a table name.
select method column option ...
Yuki Kimoto authored on 2011-02-22
1801
C<column> is column names. this is array reference or string.
cleanup
yuki-kimoto authored on 2010-08-09
1802
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1803
C<append> is a string added at the end of the SQL statement.
1804
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1805
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1806
default to 0. This is experimental.
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
1807
C<selection> is string of column name and tables. This is experimental
1808

            
1809
    selection => 'name, location.name as location_name ' .
1810
                 'from company inner join location'
update document
yuki-kimoto authored on 2009-11-19
1811

            
cleanup
yuki-kimoto authored on 2010-08-09
1812
First element is a string. it contains tags,
1813
such as "{= title} or {like author}".
1814
Second element is paramters.
1815

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
1816
C<join> is join clause after from clause.
cleanup
Yuki Kimoto authored on 2011-03-08
1817
This is experimental.
1818

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1819
=head3 C<(experimental) select_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1820

            
1821
To select row by using primary key, use C<select_at()>.
1822

            
1823
    $dbi->select_at(table => 'book', primary_key => ['id'], where => ['123']);
1824

            
1825
In this example, row which id colunm is 123 is selected.
1826
NOTE that you must pass array reference as C<where>.
1827

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1830
    $dbi->update(table  => $table, 
1831
                 param  => \%params,
1832
                 where  => \%where,
1833
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1834
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1835
                 query  => 1)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1836

            
cleanup
yuki-kimoto authored on 2010-10-17
1837
Execute update statement.
1838
C<update> method have C<table>, C<param>, C<where>, C<append>
1839
and C<filter> arguments.
1840
C<table> is a table name.
1841
C<param> is column-value pairs. this must be hash reference.
1842
C<where> is where clause. this must be hash reference.
1843
C<append> is a string added at the end of the SQL statement.
1844
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1845
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1846
default to 0. This is experimental.
cleanup
yuki-kimoto authored on 2010-10-17
1847
This is overwrites C<default_bind_filter>.
1848
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1849

            
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1850
=head2 C<(experimental) update_param>
1851

            
1852
    my $update_param = $dbi->update_param({title => 'a', age => 2});
1853

            
1854
Create update parameter tag.
1855

            
1856
    {title => 'a', age => 2}   ->   {update_param title age}
1857

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1858
=head2 C<(experimental) model>
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1859

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1860
    $dbi->model('book')->method(
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1861
        insert => sub { ... },
1862
        update => sub { ... }
1863
    );
1864
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1865
    my $model = $dbi->model('book');
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1866

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1867
Set and get a L<DBIx::Custom::Model> object,
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1868

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1869
=head2 C<(experimental) setup_model>
1870

            
1871
    $dbi->setup_model;
1872

            
1873
Setup all model objects.
1874
C<columns> and C<primary_key> is automatically set.
1875

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1878
    $dbi->update_all(table  => $table, 
1879
                     param  => \%params,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1880
                     filter => \@filter,
cleanup
yuki-kimoto authored on 2010-10-17
1881
                     append => $append);
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1882

            
cleanup
yuki-kimoto authored on 2010-10-17
1883
Execute update statement to update all rows.
1884
Arguments is same as C<update> method,
1885
except that C<update_all> don't have C<where> argument.
1886
Return value of C<update_all()> is the count of affected rows.
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1887

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1888
=head3 C<(experimental) update_at()>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1889

            
1890
To update row by using primary key, use C<update_at()>
1891

            
1892
    $dbi->update_at(
1893
        table => 'book',
1894
        primary_key => ['id'],
1895
        where => ['123'],
1896
        param => {name => 'Ken'}
1897
    );
1898

            
1899
In this example, row which id column is 123 is updated.
1900
NOTE that you must pass array reference as C<where>.
1901
If C<param> contains primary key,
1902
the key and value is delete from C<param>.
1903

            
fix tests
Yuki Kimoto authored on 2011-01-18
1904
=head2 C<(experimental) where>
1905

            
cleanup
Yuki Kimoto authored on 2011-03-09
1906
    my $where = $dbi->where(
1907
        clause => ['and', '{= title}', '{= author}'],
1908
        param => {title => 'Perl', author => 'Ken'}
1909
    );
fix tests
Yuki Kimoto authored on 2011-01-18
1910

            
1911
Create a new L<DBIx::Custom::Where> object.
1912

            
cleanup
Yuki Kimoto authored on 2011-01-25
1913
=head2 C<cache_method>
cleanup
Yuki Kimoto authored on 2011-01-12
1914

            
1915
    $dbi          = $dbi->cache_method(\&cache_method);
1916
    $cache_method = $dbi->cache_method
1917

            
1918
Method to set and get caches.
1919

            
cleanup
Yuki Kimoto authored on 2011-01-25
1920
=head1 Tags
1921

            
1922
The following tags is available.
1923

            
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
1924
=head2 C<(experimental) table>
add table tag
Yuki Kimoto authored on 2011-02-09
1925

            
1926
Table tag
1927

            
1928
    {table TABLE}    ->    TABLE
1929

            
1930
This is used to teach what is applied table to C<execute()>.
1931

            
cleanup
Yuki Kimoto authored on 2011-01-25
1932
=head2 C<?>
1933

            
1934
Placeholder tag.
1935

            
1936
    {? NAME}    ->   ?
1937

            
1938
=head2 C<=>
1939

            
1940
Equal tag.
1941

            
1942
    {= NAME}    ->   NAME = ?
1943

            
1944
=head2 C<E<lt>E<gt>>
1945

            
1946
Not equal tag.
1947

            
1948
    {<> NAME}   ->   NAME <> ?
1949

            
1950
=head2 C<E<lt>>
1951

            
1952
Lower than tag
1953

            
1954
    {< NAME}    ->   NAME < ?
1955

            
1956
=head2 C<E<gt>>
1957

            
1958
Greater than tag
1959

            
1960
    {> NAME}    ->   NAME > ?
1961

            
1962
=head2 C<E<gt>=>
1963

            
1964
Greater than or equal tag
1965

            
1966
    {>= NAME}   ->   NAME >= ?
1967

            
1968
=head2 C<E<lt>=>
1969

            
1970
Lower than or equal tag
1971

            
1972
    {<= NAME}   ->   NAME <= ?
1973

            
1974
=head2 C<like>
1975

            
1976
Like tag
1977

            
1978
    {like NAME}   ->   NAME like ?
1979

            
1980
=head2 C<in>
1981

            
1982
In tag.
1983

            
1984
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
1985

            
1986
=head2 C<insert_param>
1987

            
1988
Insert parameter tag.
1989

            
1990
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
1991

            
1992
=head2 C<update_param>
1993

            
1994
Updata parameter tag.
1995

            
1996
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
1997

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2000
L<DBIx::Custom> is stable. APIs keep backword compatible
2001
except experimental one in the feature.
DBIx::Custom is now stable
yuki-kimoto authored on 2010-09-07
2002

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

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

            
2007
C<< <kimoto.yuki at gmail.com> >>
2008

            
2009
L<http://github.com/yuki-kimoto/DBIx-Custom>
2010

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2011
=head1 AUTHOR
2012

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

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

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

            
2019
This program is free software; you can redistribute it and/or modify it
2020
under the same terms as Perl itself.
2021

            
2022
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2023

            
2024