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

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
3
our $VERSION = '0.1658';
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',
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
34
    safety_character => '\w',
update pod
Yuki Kimoto authored on 2011-02-07
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;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
467
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
468
    foreach my $column (keys %$param) {
469
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
470
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
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';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
551
    my $safety = $self->safety_character;
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}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
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 select() all_column op...
Yuki Kimoto authored on 2011-03-12
623
  = map { $_ => 1 } qw/table column where append relation filter query
624
                       selection join all_column/;
refactoring select
yuki-kimoto authored on 2010-04-28
625

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
773
our %VALID_SELECT_AT_ARGS
774
  = map { $_ => 1 } qw/table column where append relation filter query selection
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
775
                       param primary_key join all_column/;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
776

            
777
sub select_at {
778
    my ($self, %args) = @_;
779
    
cleanup
Yuki Kimoto authored on 2011-03-09
780
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
781
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
782
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
783
          unless $VALID_SELECT_AT_ARGS{$name};
784
    }
785
    
786
    # Primary key
787
    my $primary_keys = delete $args{primary_key};
788
    $primary_keys = [$primary_keys] unless ref $primary_keys;
789
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
790
    # Table
791
    croak qq{"table" option must be specified} unless $args{table};
792
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
793
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
794
    # Where clause
795
    my $where = {};
796
    if (exists $args{where}) {
797
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
798
        
799
        croak qq{"where" must be constant value or array reference}
800
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
801
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
802
        $where_columns = [$where_columns] unless ref $where_columns;
803
        
804
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
805
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
806
        }
807
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
808
    
809
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
810
        my $param = delete $args{param};
811
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
812
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
813
        }
814
    }
815
    
816
    return $self->select(where => $where, %args);
817
}
818

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
819
sub model {
820
    my ($self, $name, $model) = @_;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
821
    
822
    # Set
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
823
    if ($model) {
add models() attribute
Yuki Kimoto authored on 2011-02-21
824
        $self->models->{$name} = $model;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
825
        return $self;
826
    }
827
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
828
    # Check model existance
829
    croak qq{Model "$name" is not included}
add models() attribute
Yuki Kimoto authored on 2011-02-21
830
      unless $self->models->{$name};
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
831
    
832
    # Get
add models() attribute
Yuki Kimoto authored on 2011-02-21
833
    return $self->models->{$name};
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
834
}
835

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
902
sub setup_model {
903
    my $self = shift;
904
    
905
    $self->each_column(
906
        sub {
907
            my ($self, $table, $column, $column_info) = @_;
908
            
909
            if (my $model = $self->models->{$table}) {
910
                push @{$model->columns}, $column;
911
            }
912
        }
913
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
914
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
915
}
916

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

            
921
sub update {
922
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
923
    
cleanup
Yuki Kimoto authored on 2011-03-09
924
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
925
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
926
        croak qq{Argument "$name" is invalid name}
cleanup
yuki-kimoto authored on 2010-10-17
927
          unless $VALID_UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
928
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
929
    
cleanup
yuki-kimoto authored on 2010-10-17
930
    # Arguments
931
    my $table            = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
932
    croak qq{"table" option must be specified} unless $table;
cleanup
yuki-kimoto authored on 2010-10-17
933
    my $param            = $args{param} || {};
934
    my $where            = $args{where} || {};
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
935
    my $append           = $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
936
    my $filter           = $args{filter};
937
    my $allow_update_all = $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
938
    
cleanup
yuki-kimoto authored on 2010-10-17
939
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
940
    my @clumns = keys %$param;
941

            
942
    # Columns
943
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
944
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
945
    foreach my $column (keys %$param) {
946
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
947
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
948
        push @columns, $column;
949
    }
950
        
cleanup
yuki-kimoto authored on 2010-10-17
951
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
952
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
953

            
954
    # Where
955
    my $w;
956
    if (ref $where eq 'HASH') {
957
        my $clause = ['and'];
958
        push @$clause, "{= $_}" for keys %$where;
959
        $w = $self->where;
960
        $w->clause($clause);
961
        $w->param($where);
962
    }
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
963
    elsif (ref $where eq 'DBIx::Custom::Where') {
964
        $w = $where;
965
        $where = $w->param;
966
    }  
removed experimental registe...
yuki-kimoto authored on 2010-08-24
967
    
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
968
    croak qq{"where" must be hash refernce or DBIx::Custom::Where object}
969
      unless ref $w eq 'DBIx::Custom::Where';
removed reconnect method
yuki-kimoto authored on 2010-05-28
970
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
971
    # String where
972
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
973
    
974
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
975
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
976
    
cleanup
Yuki Kimoto authored on 2011-01-27
977
    # SQL stack
978
    my @sql;
979
    
980
    # Update
981
    push @sql, "update $table $update_clause $swhere";
982
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
983
    
cleanup
yuki-kimoto authored on 2010-10-17
984
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
985
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
986
        
cleanup
yuki-kimoto authored on 2010-10-17
987
        if (exists $param->{$wkey}) {
988
            $param->{$wkey} = [$param->{$wkey}]
989
              unless ref $param->{$wkey} eq 'ARRAY';
990
            
991
            push @{$param->{$wkey}}, $where->{$wkey};
992
        }
993
        else {
994
            $param->{$wkey} = $where->{$wkey};
995
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
996
    }
cleanup
yuki-kimoto authored on 2010-10-17
997
    
cleanup
Yuki Kimoto authored on 2011-01-27
998
    # SQL
999
    my $sql = join(' ', @sql);
1000
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1001
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1002
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1003
    return $query if $args{query};
1004
    
cleanup
yuki-kimoto authored on 2010-10-17
1005
    # Execute query
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1006
    my $ret_val = $self->execute($query, param  => $param, 
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1007
                                 filter => $filter,
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1008
                                 table => $table);
cleanup
yuki-kimoto authored on 2010-10-17
1009
    
1010
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1011
}
1012

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

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1015
our %VALID_UPDATE_AT_ARGS
1016
  = map { $_ => 1 } qw/table param
1017
                       where append filter query
1018
                       primary_key param/;
1019

            
1020
sub update_at {
1021
    my ($self, %args) = @_;
1022
    
cleanup
Yuki Kimoto authored on 2011-03-09
1023
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1024
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1025
        croak qq{Argument "$name" is invalid name}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1026
          unless $VALID_UPDATE_AT_ARGS{$name};
1027
    }
1028
    
1029
    # Primary key
1030
    my $primary_keys = delete $args{primary_key};
1031
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1032
    
1033
    # Where clause
1034
    my $where = {};
1035
    my $param = {};
1036
    
1037
    if (exists $args{where}) {
1038
        my $where_columns = delete $args{where};
1039
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1040

            
1041
        croak qq{"where" must be constant value or array reference}
1042
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1043
        
1044
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1045
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1046
        }
1047
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1048
    
1049
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1050
        $param = delete $args{param};
1051
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1052
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1053
        }
1054
    }
1055
    
1056
    return $self->update(where => $where, param => $param, %args);
1057
}
1058

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1059
sub update_param {
1060
    my ($self, $param) = @_;
1061
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1062
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1063
    my @tag;
1064
    push @tag, '{update_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1065
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1066
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1067
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1068
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1069
        push @tag, $column;
1070
    }
1071
    push @tag, '}';
1072
    
1073
    return join ' ', @tag;
1074
}
1075

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

            
1079
    return DBIx::Custom::Where->new(
1080
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1081
        safety_character => $self->safety_character,
cleanup
Yuki Kimoto authored on 2011-03-09
1082
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1083
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1084
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1085

            
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1086
sub _bind {
cleanup
Yuki Kimoto authored on 2011-01-12
1087
    my ($self, $params, $columns, $filter) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1088
    
cleanup
Yuki Kimoto authored on 2011-01-12
1089
    # bind values
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1090
    my @bind;
add tests
yuki-kimoto authored on 2010-08-08
1091
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1092
    # Build bind values
1093
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1094
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1095
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1096
        
1097
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1098
        my $value;
1099
        if(ref $params->{$column} eq 'ARRAY') {
1100
            my $i = $count->{$column} || 0;
1101
            $i += $not_exists->{$column} || 0;
1102
            my $found;
1103
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1104
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1105
                    $not_exists->{$column}++;
1106
                }
1107
                else  {
1108
                    $value = $params->{$column}->[$k];
1109
                    $found = 1;
1110
                    last
1111
                }
1112
            }
1113
            next unless $found;
1114
        }
1115
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1116
        
cleanup
Yuki Kimoto authored on 2011-01-12
1117
        # Filter
1118
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1119
        
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1120
        push @bind, $f ? $f->($value) : $value;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1121
        
1122
        # Count up 
1123
        $count->{$column}++;
1124
    }
1125
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1126
    return \@bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1127
}
1128

            
cleanup
yuki-kimoto authored on 2010-10-17
1129
sub _croak {
1130
    my ($self, $error, $append) = @_;
1131
    $append ||= "";
1132
    
1133
    # Verbose
1134
    if ($Carp::Verbose) { croak $error }
1135
    
1136
    # Not verbose
1137
    else {
1138
        
1139
        # Remove line and module infromation
1140
        my $at_pos = rindex($error, ' at ');
1141
        $error = substr($error, 0, $at_pos);
1142
        $error =~ s/\s+$//;
1143
        
1144
        croak "$error$append";
1145
    }
1146
}
1147

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1148
sub _need_tables {
1149
    my ($self, $tree, $need_tables, $tables) = @_;
1150
    
1151
    foreach my $table (@$tables) {
1152
        
1153
        if ($tree->{$table}) {
1154
            $need_tables->{$table} = 1;
1155
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1156
        }
1157
    }
1158
}
1159

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1160
sub _tables {
1161
    my ($self, $source) = @_;
1162
    
1163
    my $tables = [];
1164
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1165
    my $safety_character = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1166
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1167
    while ($source =~ /\b($safety_character+)\./g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1168
        push @$tables, $1;
1169
    }
1170
    
1171
    return $tables;
1172
}
1173

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1174
sub _push_join {
1175
    my ($self, $sql, $join, $join_tables) = @_;
1176
    
1177
    return unless @$join;
1178
    
1179
    my $tree = {};
1180
    
1181
    for (my $i = 0; $i < @$join; $i++) {
1182
        
1183
        my $join_clause = $join->[$i];
1184
        
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
1185
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1186
            
1187
            my $table1 = $1;
1188
            my $table2 = $2;
1189
            
1190
            croak qq{right side table of "$join_clause" must be uniq}
1191
              if exists $tree->{$table2};
1192
            
1193
            $tree->{$table2}
1194
              = {position => $i, parent => $table1, join => $join_clause};
1195
        }
1196
        else {
1197
            croak qq{join "$join_clause" must be two table name};
1198
        }
1199
    }
1200
    
1201
    my $need_tables = {};
1202
    $self->_need_tables($tree, $need_tables, $join_tables);
1203
    
1204
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1205

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1206
    foreach my $need_table (@need_tables) {
1207
        push @$sql, $tree->{$need_table}{join};
1208
    }
1209
}
cleanup
Yuki Kimoto authored on 2011-03-08
1210

            
cleanup
Yuki Kimoto authored on 2011-01-25
1211
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1212
__PACKAGE__->attr(
1213
    dbi_options => sub { {} },
1214
    filter_check  => 1
1215
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1216

            
cleanup
Yuki Kimoto authored on 2011-01-25
1217
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1218
sub default_bind_filter {
1219
    my $self = shift;
1220
    
1221
    if (@_) {
1222
        my $fname = $_[0];
1223
        
1224
        if (@_ && !$fname) {
1225
            $self->{default_out_filter} = undef;
1226
        }
1227
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1228
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1229
              unless exists $self->filters->{$fname};
1230
        
1231
            $self->{default_out_filter} = $self->filters->{$fname};
1232
        }
1233
        return $self;
1234
    }
1235
    
1236
    return $self->{default_out_filter};
1237
}
1238

            
cleanup
Yuki Kimoto authored on 2011-01-25
1239
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1240
sub default_fetch_filter {
1241
    my $self = shift;
1242
    
1243
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1244
        my $fname = $_[0];
1245

            
cleanup
Yuki Kimoto authored on 2011-01-12
1246
        if (@_ && !$fname) {
1247
            $self->{default_in_filter} = undef;
1248
        }
1249
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1250
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1251
              unless exists $self->filters->{$fname};
1252
        
1253
            $self->{default_in_filter} = $self->filters->{$fname};
1254
        }
1255
        
1256
        return $self;
1257
    }
1258
    
many changed
Yuki Kimoto authored on 2011-01-23
1259
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1260
}
1261

            
cleanup
Yuki Kimoto authored on 2011-01-25
1262
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1263
sub register_tag_processor {
1264
    return shift->query_builder->register_tag_processor(@_);
1265
}
1266

            
cleanup
Yuki Kimoto authored on 2011-03-08
1267
# DEPRECATED!
1268
sub _push_relation {
1269
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1270
    
1271
    if (keys %{$relation || {}}) {
1272
        push @$sql, $need_where ? 'where' : 'and';
1273
        foreach my $rcolumn (keys %$relation) {
1274
            my $table1 = (split (/\./, $rcolumn))[0];
1275
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1276
            push @$tables, ($table1, $table2);
1277
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1278
        }
1279
    }
1280
    pop @$sql if $sql->[-1] eq 'and';    
1281
}
1282

            
1283
# DEPRECATED!
1284
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1285
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1286
    
1287
    if (keys %{$relation || {}}) {
1288
        foreach my $rcolumn (keys %$relation) {
1289
            my $table1 = (split (/\./, $rcolumn))[0];
1290
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1291
            my $table1_exists;
1292
            my $table2_exists;
1293
            foreach my $table (@$tables) {
1294
                $table1_exists = 1 if $table eq $table1;
1295
                $table2_exists = 1 if $table eq $table2;
1296
            }
1297
            unshift @$tables, $table1 unless $table1_exists;
1298
            unshift @$tables, $table2 unless $table2_exists;
1299
        }
1300
    }
1301
}
1302

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1305
=head1 NAME
1306

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

            
1309
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1310

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1311
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1312
    
1313
    # Connect
1314
    my $dbi = DBIx::Custom->connect(
1315
        data_source => "dbi:mysql:database=dbname",
1316
        user => 'ken',
1317
        password => '!LFKD%$&',
1318
        dbi_option => {mysql_enable_utf8 => 1}
1319
    );
cleanup
yuki-kimoto authored on 2010-08-05
1320

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1321
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1322
    $dbi->insert(
1323
        table  => 'book',
1324
        param  => {title => 'Perl', author => 'Ken'}
1325
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1326
    
1327
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1328
    $dbi->update(
1329
        table  => 'book', 
1330
        param  => {title => 'Perl', author => 'Ken'}, 
1331
        where  => {id => 5},
1332
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1333
    
1334
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1335
    $dbi->delete(
1336
        table  => 'book',
1337
        where  => {author => 'Ken'},
1338
    );
cleanup
yuki-kimoto authored on 2010-08-05
1339

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1346
    # Select, more complex
1347
    my $result = $dbi->select(
1348
        table  => 'book',
1349
        column => [
1350
            'book.author as book__author',
1351
            'company.name as company__name'
1352
        ],
1353
        where  => {'book.author' => 'Ken'},
1354
        join => ['left outer join company on book.company_id = company.id'],
1355
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1356
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1357
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1358
    # Fetch
1359
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1360
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1361
    }
1362
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1363
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1364
    while (my $row = $result->fetch_hash) {
1365
        
1366
    }
1367
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1368
    # Execute SQL with parameter.
1369
    $dbi->execute(
1370
        "select id from book where {= author} and {like title}",
1371
        param  => {author => 'ken', title => '%Perl%'}
1372
    );
1373
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1374
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1375

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

            
1378
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1379

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1384
There are many basic methods to execute various queries.
1385
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1386
C<delete_all()>, C<select()>,
1387
C<insert_at()>, C<update_at()>, 
1388
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1389

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1390
=item *
1391

            
1392
Filter when data is send or receive.
1393

            
1394
=item *
1395

            
1396
Data filtering system
1397

            
1398
=item *
1399

            
1400
Model support.
1401

            
1402
=item *
1403

            
1404
Generate where clause dinamically.
1405

            
1406
=item *
1407

            
1408
Generate join clause dinamically.
1409

            
1410
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1411

            
1412
=head1 GUIDE
1413

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

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

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

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1427
Enable caching of L<DBIx::Custom::Query>,
1428
default to 1.
packaging one directory
yuki-kimoto authored on 2009-11-16
1429

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

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

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1442
Database handle of L<DBI>.
packaging one directory
yuki-kimoto authored on 2009-11-16
1443

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

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

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

            
1452
=head2 C<default_dbi_option>
1453

            
1454
    my $default_dbi_option = $dbi->default_dbi_option;
1455
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1456

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1460
    {
1461
        RaiseError => 1,
1462
        PrintError => 0,
1463
        AutoCommit => 1,
1464
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1465

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1473
=head2 C<models EXPERIMENTAL>
add models() attribute
Yuki Kimoto authored on 2011-02-21
1474

            
1475
    my $models = $dbi->models;
1476
    $dbi       = $dbi->models(\%models);
1477

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1480
=head2 C<password>
1481

            
1482
    my $password = $dbi->password;
1483
    $dbi         = $dbi->password('lkj&le`@s');
1484

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

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

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

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

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1501
=head2 C<safety_character EXPERIMENTAL>
update pod
Yuki Kimoto authored on 2011-01-27
1502

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1506
Regex of safety character consist of table and column name, default to '\w'.
cleanup
Yuki Kimoto authored on 2011-03-10
1507
Note that you don't have to specify like '[\w]'.
update pod
Yuki Kimoto authored on 2011-01-27
1508

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1511
    my $user = $dbi->user;
1512
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1513

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1522
=head2 C<apply_filter EXPERIMENTAL>
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1523

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1524
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1525
        'book',
1526
        $column1 => {out => $outfilter1, in => $infilter1, end => $endfilter1}
1527
        $column2 => {out => $outfilter2, in => $infilter2, end => $endfilter2}
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1528
        ...,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1529
    );
1530

            
cleanup
Yuki Kimoto authored on 2011-03-10
1531
Apply filter to specified column, C<out> is the direction from perl to database,
1532
C<in> is the direction from database to perl,
1533
C<end> is filter after C<in> filter.
cleanup
Yuki Kimoto authored on 2010-12-21
1534

            
cleanup
Yuki Kimoto authored on 2011-03-10
1535
You can use three column name to apply filter to column data.
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1536

            
cleanup
Yuki Kimoto authored on 2011-03-10
1537
                       (Example)
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1538
    1. column        : author
1539
    2. table.column  : book.author
1540
    3. table__column : book__author
1541

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

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

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

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

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

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

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

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

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

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

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

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1583
Execute delete statement.
1584
C<delete> method have C<table>, C<where>, C<append>, and C<filter> arguments.
1585
C<table> is a table name.
1586
C<where> is where clause. this must be hash reference.
1587
C<append> is a string added at the end of the SQL statement.
1588
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1589
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1590
default to 0. This is EXPERIMENTAL.
cleanup
yuki-kimoto authored on 2010-08-09
1591
Return value of C<delete()> is the count of affected rows.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1592

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1602
=head3 C<delete_at() EXPERIMENTAL>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1603

            
1604
To delete row by using primary key, use C<delete_at()>
1605

            
1606
    $dbi->delete_at(
1607
        table => 'book',
1608
        primary_key => ['id'],
1609
        where => ['123']
1610
    );
1611

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

            
1615
You can also write arguments like this.
1616

            
1617
    $dbi->delete_at(
1618
        table => 'book',
1619
        primary_key => ['id'],
1620
        param => {id => '123'}
1621
    );
1622

            
cleanup
yuki-kimoto authored on 2010-10-17
1623
=head2 C<insert>
1624

            
1625
    $dbi->insert(table  => $table, 
1626
                 param  => \%param,
1627
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1628
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1629
                 query  => 1);
cleanup
yuki-kimoto authored on 2010-10-17
1630

            
1631
Execute insert statement.
1632
C<insert> method have C<table>, C<param>, C<append>
1633
and C<filter> arguments.
1634
C<table> is a table name.
1635
C<param> is the pairs of column name value. this must be hash reference.
1636
C<append> is a string added at the end of the SQL statement.
1637
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1638
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1639
default to 0. This is EXPERIMENTAL.
cleanup
yuki-kimoto authored on 2010-10-17
1640
This is overwrites C<default_bind_filter>.
1641
Return value of C<insert()> is the count of affected rows.
1642

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1643
=head3 C<insert_at() EXPERIMENTAL>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
1644

            
1645
To insert row by using primary key, use C<insert_at()>
1646

            
1647
    $dbi->insert_at(
1648
        table => 'book',
1649
        primary_key => ['id'],
1650
        where => ['123'],
1651
        param => {name => 'Ken'}
1652
    );
1653

            
1654
In this example, row which id column is 123 is inserted.
1655
NOTE that you must pass array reference as C<where>.
1656
If C<param> contains primary key,
1657
the key and value is delete from C<param>.
1658

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1659
=head2 C<insert_param EXPERIMENTAL>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1660

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

            
1663
Create insert parameter tag.
1664

            
1665
    {title => 'a', age => 2}   ->   {insert_param title age}
1666

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1667
=head2 C<each_column EXPERIMENTAL>
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1668

            
pod fix
Yuki Kimoto authored on 2011-01-21
1669
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1670
        sub {
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1671
            my ($self, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1672
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1673
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
1674
            
1675
            if ($type eq 'DATE') {
1676
                # ...
1677
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1678
        }
1679
    );
pod fix
Yuki Kimoto authored on 2011-01-21
1680
Get column informations from database.
1681
Argument is callback.
1682
You can do anything in callback.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1683
Callback receive four arguments, dbi object, table name,
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1684
column name and column information.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1685

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1686
=head2 C<include_model EXPERIMENTAL>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1687

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1688
    $dbi->include_model(
1689
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1690
            'book', 'person', 'company'
1691
        ]
1692
    );
1693

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

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

            
1700
    $dbi->include_model('MyModel');
1701

            
1702
Note that in this case name spece module is needed.
1703

            
1704
    # MyModel.pm
1705
    package MyModel;
1706
    
1707
    use base 'DBIx::Custom::Model';
1708

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1711
    MyModel::book
1712
    MyModel::person
1713
    MyModel::company
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1714

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

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

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1722
    $dbi->include_model(
1723
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1724
            {'book' => 'Book'},
1725
            {'person' => 'Person'}
1726
        ]
1727
    );
1728

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1729
=head2 C<method EXPERIMENTAL>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1730

            
1731
    $dbi->method(
1732
        update_or_insert => sub {
1733
            my $self = shift;
1734
            # do something
1735
        },
1736
        find_or_create   => sub {
1737
            my $self = shift;
1738
            # do something
1739
        }
1740
    );
1741

            
1742
Register method. These method is called from L<DBIx::Custom> object directory.
1743

            
1744
    $dbi->update_or_insert;
1745
    $dbi->find_or_create;
1746

            
1747
=head2 C<new>
1748

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

            
1752
Create a new L<DBIx::Custom> object.
1753

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1754
=head2 C<not_exists EXPERIMENTAL>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1755

            
1756
    my $not_exists = $dbi->not_exists;
1757

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1760
=head2 C<register_filter>
1761

            
1762
    $dbi->register_filter(%filters);
1763
    $dbi->register_filter(\%filters);
1764
    
1765
Register filter. Registered filters is available in the following attributes
1766
or arguments.
1767

            
1768
=over 4
1769

            
1770
=item *
1771

            
1772
C<filter> argument of C<insert()>, C<update()>,
1773
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1774
methods
1775

            
1776
=item *
1777

            
1778
C<execute()> method
1779

            
1780
=item *
1781

            
1782
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1783

            
1784
=item *
1785

            
1786
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1787

            
1788
=back
1789

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

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1792
    $dbi->register_tag(
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1793
        limit => sub {
1794
            ...;
1795
        }
1796
    );
1797

            
cleanup
Yuki Kimoto authored on 2011-01-25
1798
Register tag.
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1799

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

            
1802
    $dbi->rollback;
1803

            
1804
Rollback transaction.
1805
This is same as L<DBI>'s C<rollback>.
1806

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
1809
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1810
        table  => 'book',
1811
        column => ['author', 'title'],
1812
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
1813
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1814
    
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1815
Execute select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1816

            
1817
The following opitons are currently available.
1818

            
1819
=over 4
1820

            
1821
=item C<table>
1822

            
1823
Table name.
1824

            
1825
    $dbi->select(table => 'book', ...);
1826

            
1827
=item C<column>
1828

            
1829
Column clause. This is array reference or constant value.
1830

            
1831
    # Hash refernce
1832
    $dbi->select(column => ['author', 'title']);
1833
    
1834
    # Constant value
1835
    $dbi->select(column => 'author');
1836

            
1837
Default is '*' unless C<column> is specified.
1838

            
1839
    # Default
1840
    $dbi->select(column => '*');
1841

            
1842
=item C<all_column EXPERIMENTAL>
1843

            
1844
Colum clause, contains all columns. This is true or false value
1845

            
1846
    $dbi->select(all_column => 1, ...);
1847

            
1848
If main table is C<book> and joined table is C<company>,
1849
This create the following column clause.
1850

            
1851
    book.author as author
1852
    book.company_id as company_id
1853
    company.id as company__id
1854
    company.name as company__name
1855

            
1856
Columns of main table is consist of only column name,
1857
Columns of joined table is consist of table and column name joined C<__>.
1858

            
1859
=item C<where>
1860

            
1861
Where clause. This is hash reference or L<DBIx::Custom::Where> object.
1862
    
1863
    # Hash reference
1864
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'}, ...);
1865
    
1866
    # Where clause
1867
    my $where = $dbi->where(
1868
        clause => ['and', '{= author}', '{like title}'],
1869
        param  => {author => 'Ken', title => '%Perl%'}
1870
    );
1871
    $dbi->select(where => $where, ...);
1872

            
1873
=back
1874

            
1875
C<filter> arguments.
cleanup
yuki-kimoto authored on 2010-08-09
1876
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1877
C<append> is a string added at the end of the SQL statement.
1878
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1879
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1880
default to 0. This is EXPERIMENTAL.
1881
C<selection> is string of column name and tables. This is EXPERIMENTAL
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
1882

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

            
cleanup
yuki-kimoto authored on 2010-08-09
1886
First element is a string. it contains tags,
1887
such as "{= title} or {like author}".
1888
Second element is paramters.
1889

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
1890
C<join> is join clause after from clause.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1891
This is EXPERIMENTAL.
cleanup
Yuki Kimoto authored on 2011-03-08
1892

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1893
=head3 C<select_at() EXPERIMENTAL>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1894

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1904
    $dbi->update(table  => $table, 
1905
                 param  => \%params,
1906
                 where  => \%where,
1907
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1908
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1909
                 query  => 1)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1910

            
cleanup
yuki-kimoto authored on 2010-10-17
1911
Execute update statement.
1912
C<update> method have C<table>, C<param>, C<where>, C<append>
1913
and C<filter> arguments.
1914
C<table> is a table name.
1915
C<param> is column-value pairs. this must be hash reference.
1916
C<where> is where clause. this must be hash reference.
1917
C<append> is a string added at the end of the SQL statement.
1918
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1919
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1920
default to 0. This is EXPERIMENTAL.
cleanup
yuki-kimoto authored on 2010-10-17
1921
This is overwrites C<default_bind_filter>.
1922
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1923

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1924
=head2 C<update_param EXPERIMENTAL>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1925

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

            
1928
Create update parameter tag.
1929

            
1930
    {title => 'a', age => 2}   ->   {update_param title age}
1931

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1932
=head2 C<model EXPERIMENTAL>
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1933

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1934
    $dbi->model('book')->method(
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1935
        insert => sub { ... },
1936
        update => sub { ... }
1937
    );
1938
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1939
    my $model = $dbi->model('book');
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1940

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1943
=head2 C<setup_model EXPERIMENTAL>
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1944

            
1945
    $dbi->setup_model;
1946

            
1947
Setup all model objects.
1948
C<columns> and C<primary_key> is automatically set.
1949

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1962
=head3 C<update_at() EXPERIMENTAL>
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1963

            
1964
To update row by using primary key, use C<update_at()>
1965

            
1966
    $dbi->update_at(
1967
        table => 'book',
1968
        primary_key => ['id'],
1969
        where => ['123'],
1970
        param => {name => 'Ken'}
1971
    );
1972

            
1973
In this example, row which id column is 123 is updated.
1974
NOTE that you must pass array reference as C<where>.
1975
If C<param> contains primary key,
1976
the key and value is delete from C<param>.
1977

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1978
=head2 C<where EXPERIMENTAL>
fix tests
Yuki Kimoto authored on 2011-01-18
1979

            
cleanup
Yuki Kimoto authored on 2011-03-09
1980
    my $where = $dbi->where(
1981
        clause => ['and', '{= title}', '{= author}'],
1982
        param => {title => 'Perl', author => 'Ken'}
1983
    );
fix tests
Yuki Kimoto authored on 2011-01-18
1984

            
1985
Create a new L<DBIx::Custom::Where> object.
1986

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

            
1989
    $dbi          = $dbi->cache_method(\&cache_method);
1990
    $cache_method = $dbi->cache_method
1991

            
1992
Method to set and get caches.
1993

            
cleanup
Yuki Kimoto authored on 2011-01-25
1994
=head1 Tags
1995

            
1996
The following tags is available.
1997

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1998
=head2 C<table EXPERIMENTAL>
add table tag
Yuki Kimoto authored on 2011-02-09
1999

            
2000
Table tag
2001

            
2002
    {table TABLE}    ->    TABLE
2003

            
2004
This is used to teach what is applied table to C<execute()>.
2005

            
cleanup
Yuki Kimoto authored on 2011-01-25
2006
=head2 C<?>
2007

            
2008
Placeholder tag.
2009

            
2010
    {? NAME}    ->   ?
2011

            
2012
=head2 C<=>
2013

            
2014
Equal tag.
2015

            
2016
    {= NAME}    ->   NAME = ?
2017

            
2018
=head2 C<E<lt>E<gt>>
2019

            
2020
Not equal tag.
2021

            
2022
    {<> NAME}   ->   NAME <> ?
2023

            
2024
=head2 C<E<lt>>
2025

            
2026
Lower than tag
2027

            
2028
    {< NAME}    ->   NAME < ?
2029

            
2030
=head2 C<E<gt>>
2031

            
2032
Greater than tag
2033

            
2034
    {> NAME}    ->   NAME > ?
2035

            
2036
=head2 C<E<gt>=>
2037

            
2038
Greater than or equal tag
2039

            
2040
    {>= NAME}   ->   NAME >= ?
2041

            
2042
=head2 C<E<lt>=>
2043

            
2044
Lower than or equal tag
2045

            
2046
    {<= NAME}   ->   NAME <= ?
2047

            
2048
=head2 C<like>
2049

            
2050
Like tag
2051

            
2052
    {like NAME}   ->   NAME like ?
2053

            
2054
=head2 C<in>
2055

            
2056
In tag.
2057

            
2058
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2059

            
2060
=head2 C<insert_param>
2061

            
2062
Insert parameter tag.
2063

            
2064
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2065

            
2066
=head2 C<update_param>
2067

            
2068
Updata parameter tag.
2069

            
2070
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2071

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

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

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

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

            
2081
C<< <kimoto.yuki at gmail.com> >>
2082

            
2083
L<http://github.com/yuki-kimoto/DBIx-Custom>
2084

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2085
=head1 AUTHOR
2086

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

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

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

            
2093
This program is free software; you can redistribute it and/or modify it
2094
under the same terms as Perl itself.
2095

            
2096
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2097

            
2098