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

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
3
our $VERSION = '0.1655';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
435
        return $result;
436
    }
437
    return $affected;
438
}
439

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

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

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
492
our %VALID_INSERT_AT_ARGS
493
  = map { $_ => 1 } qw/table param
494
                       where append filter query
495
                       primary_key param/;
496

            
497
sub insert_at {
498
    my ($self, %args) = @_;
499
    
500
    # Check arguments
501
    foreach my $name (keys %args) {
502
        croak qq{"$name" is invalid argument}
503
          unless $VALID_INSERT_AT_ARGS{$name};
504
    }
505
    
506
    # Primary key
507
    my $primary_keys = delete $args{primary_key};
508
    $primary_keys = [$primary_keys] unless ref $primary_keys;
509
    
510
    # Where clause
511
    my $where = {};
512
    my $param = {};
513
    
514
    if (exists $args{where}) {
515
        my $where_columns = delete $args{where};
516
        $where_columns = [$where_columns] unless ref $where_columns;
517

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

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
574
sub new {
575
    my $self = shift->SUPER::new(@_);
576
    
577
    # Check attribute names
578
    my @attrs = keys %$self;
579
    foreach my $attr (@attrs) {
580
        croak qq{"$attr" is invalid attribute name}
581
          unless $self->can($attr);
582
    }
cleanup
Yuki Kimoto authored on 2011-01-25
583

            
584
    $self->register_tag(
585
        '?'     => \&DBIx::Custom::Tag::placeholder,
586
        '='     => \&DBIx::Custom::Tag::equal,
587
        '<>'    => \&DBIx::Custom::Tag::not_equal,
588
        '>'     => \&DBIx::Custom::Tag::greater_than,
589
        '<'     => \&DBIx::Custom::Tag::lower_than,
590
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
591
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
592
        'like'  => \&DBIx::Custom::Tag::like,
593
        'in'    => \&DBIx::Custom::Tag::in,
594
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
595
        'update_param' => \&DBIx::Custom::Tag::update_param
596
    );
added dbi_options attribute
kimoto authored on 2010-12-20
597
    
598
    return $self;
599
}
600

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

            
cleanup
yuki-kimoto authored on 2010-10-17
603
sub register_filter {
604
    my $invocant = shift;
605
    
606
    # Register filter
607
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
608
    $invocant->filters({%{$invocant->filters}, %$filters});
609
    
610
    return $invocant;
611
}
packaging one directory
yuki-kimoto authored on 2009-11-16
612

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
615
our %VALID_SELECT_ARGS
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
616
  = map { $_ => 1 } qw/table column where append relation filter query selection left_join/;
refactoring select
yuki-kimoto authored on 2010-04-28
617

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1055
    return DBIx::Custom::Where->new(
1056
        query_builder => $self->query_builder,
1057
        safety_column_name => $self->safety_column_name
1058
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1059
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1060

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-08
1137

            
1138

            
cleanup
Yuki Kimoto authored on 2011-01-25
1139
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1140
__PACKAGE__->attr(
1141
    dbi_options => sub { {} },
1142
    filter_check  => 1
1143
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1144

            
cleanup
Yuki Kimoto authored on 2011-01-25
1145
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1146
sub default_bind_filter {
1147
    my $self = shift;
1148
    
1149
    if (@_) {
1150
        my $fname = $_[0];
1151
        
1152
        if (@_ && !$fname) {
1153
            $self->{default_out_filter} = undef;
1154
        }
1155
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1156
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1157
              unless exists $self->filters->{$fname};
1158
        
1159
            $self->{default_out_filter} = $self->filters->{$fname};
1160
        }
1161
        return $self;
1162
    }
1163
    
1164
    return $self->{default_out_filter};
1165
}
1166

            
cleanup
Yuki Kimoto authored on 2011-01-25
1167
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1168
sub default_fetch_filter {
1169
    my $self = shift;
1170
    
1171
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1172
        my $fname = $_[0];
1173

            
cleanup
Yuki Kimoto authored on 2011-01-12
1174
        if (@_ && !$fname) {
1175
            $self->{default_in_filter} = undef;
1176
        }
1177
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1178
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1179
              unless exists $self->filters->{$fname};
1180
        
1181
            $self->{default_in_filter} = $self->filters->{$fname};
1182
        }
1183
        
1184
        return $self;
1185
    }
1186
    
many changed
Yuki Kimoto authored on 2011-01-23
1187
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1188
}
1189

            
cleanup
Yuki Kimoto authored on 2011-01-25
1190
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1191
sub register_tag_processor {
1192
    return shift->query_builder->register_tag_processor(@_);
1193
}
1194

            
cleanup
Yuki Kimoto authored on 2011-03-08
1195
# DEPRECATED!
1196
sub _push_relation {
1197
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1198
    
1199
    if (keys %{$relation || {}}) {
1200
        push @$sql, $need_where ? 'where' : 'and';
1201
        foreach my $rcolumn (keys %$relation) {
1202
            my $table1 = (split (/\./, $rcolumn))[0];
1203
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1204
            push @$tables, ($table1, $table2);
1205
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1206
        }
1207
    }
1208
    pop @$sql if $sql->[-1] eq 'and';    
1209
}
1210

            
1211
# DEPRECATED!
1212
sub _add_relation_table {
1213
    my ($self, $relation, $tables) = @_;
1214
    
1215
    if (keys %{$relation || {}}) {
1216
        foreach my $rcolumn (keys %$relation) {
1217
            my $table1 = (split (/\./, $rcolumn))[0];
1218
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1219
            my $table1_exists;
1220
            my $table2_exists;
1221
            foreach my $table (@$tables) {
1222
                $table1_exists = 1 if $table eq $table1;
1223
                $table2_exists = 1 if $table eq $table2;
1224
            }
1225
            unshift @$tables, $table1 unless $table1_exists;
1226
            unshift @$tables, $table2 unless $table2_exists;
1227
        }
1228
    }
1229
}
1230

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1233
=head1 NAME
1234

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

            
1237
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1238

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1244
    # Insert 
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1245
    $dbi->insert(table  => 'book',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1246
                 param  => {title => 'Perl', author => 'Ken'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1247
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1248
    
1249
    # Update 
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1250
    $dbi->update(table  => 'book', 
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1251
                 param  => {title => 'Perl', author => 'Ken'}, 
removed reconnect method
yuki-kimoto authored on 2010-05-28
1252
                 where  => {id => 5},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1253
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1254
    
1255
    # Update all
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1256
    $dbi->update_all(table  => 'book',
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1257
                     param  => {title => 'Perl'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1258
                     filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1259
    
1260
    # Delete
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1261
    $dbi->delete(table  => 'book',
removed reconnect method
yuki-kimoto authored on 2010-05-28
1262
                 where  => {author => 'Ken'},
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1263
                 filter => [title => 'to_something']);
removed reconnect method
yuki-kimoto authored on 2010-05-28
1264
    
1265
    # Delete all
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1266
    $dbi->delete_all(table => 'book');
cleanup
yuki-kimoto authored on 2010-08-05
1267

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1268
    # Select
renamed fetch_rows to fetch_...
yuki-kimoto authored on 2010-05-01
1269
    my $result = $dbi->select(
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
1270
        table  => 'book',
update document
yuki-kimoto authored on 2010-05-27
1271
        column => [qw/author title/],
1272
        where  => {author => 'Ken'},
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1273
        relation => {'book.id' => 'rental.book_id'},
updated document
yuki-kimoto authored on 2010-08-08
1274
        append => 'order by id limit 5',
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1275
        filter => [title => 'to_something']
added commit method
yuki-kimoto authored on 2010-05-27
1276
    );
cleanup
yuki-kimoto authored on 2010-08-05
1277

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

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

            
1292
    # Get DBI object
1293
    my $dbh = $dbi->dbh;
1294

            
removed register_format()
yuki-kimoto authored on 2010-05-26
1295
    # Fetch
1296
    while (my $row = $result->fetch) {
1297
        # ...
1298
    }
1299
    
1300
    # Fetch hash
1301
    while (my $row = $result->fetch_hash) {
1302
        
1303
    }
1304
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1305
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1306

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

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

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

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

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

            
1329
=head1 GUIDE
1330

            
1331
L<DBIx::Custom::Guide> - L<DBIx::Custom> complete guide
1332

            
1333
=head1 EXAMPLES
1334

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1367
DBI options.
add default_dbi_option()
Yuki Kimoto authored on 2011-02-19
1368

            
1369
Each option specified can ovewrite C<default_dbi_option>.
1370

            
1371
C<connect()> method use this value to connect the database.
1372

            
1373

            
1374
=head2 C<default_dbi_option>
1375

            
1376
    my $default_dbi_option = $dbi->default_dbi_option;
1377
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1378

            
1379
DBI default options.
1380

            
1381
    RaiseError => 1,
1382
    PrintError => 0,
1383
    AutoCommit => 1,
1384

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

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

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

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

            
add models() attribute
Yuki Kimoto authored on 2011-02-21
1394
Filters
1395

            
1396
=head2 C<(experimental) models>
1397

            
1398
    my $models = $dbi->models;
1399
    $dbi       = $dbi->models(\%models);
1400

            
1401
Models
1402

            
cleanup
yuki-kimoto authored on 2010-10-17
1403
=head2 C<password>
1404

            
1405
    my $password = $dbi->password;
1406
    $dbi         = $dbi->password('lkj&le`@s');
1407

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

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

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

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

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

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

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

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

            
1430
    my $safety_column_name = $self->safety_column_name;
1431
    $dbi                   = $self->safety_column_name($name);
1432

            
1433
Safety column name regex.
1434
Default is qr/^[\w\.]*$/
1435

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1438
    my $user = $dbi->user;
1439
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1440

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1452
    $dbi->apply_filter(
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1453
        $table,
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1454
        $column1 => {in => $infilter1, out => $outfilter1, end => $endfilter1}
1455
        $column2 => {in => $infilter2, out => $outfilter2, end =. $endfilter2}
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1456
        ...,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1457
    );
1458

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

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

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

            
1472
You can use three name as column name.
1473

            
1474
    1. column        : author
1475
    2. table.column  : book.author
1476
    3. table__column : book__author
1477

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1540
To delete row by using primary key, use C<delete_at()>
1541

            
1542
    $dbi->delete_at(
1543
        table => 'book',
1544
        primary_key => ['id'],
1545
        where => ['123']
1546
    );
1547

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

            
1551
You can also write arguments like this.
1552

            
1553
    $dbi->delete_at(
1554
        table => 'book',
1555
        primary_key => ['id'],
1556
        param => {id => '123'}
1557
    );
1558

            
cleanup
yuki-kimoto authored on 2010-10-17
1559
=head2 C<insert>
1560

            
1561
    $dbi->insert(table  => $table, 
1562
                 param  => \%param,
1563
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1564
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1565
                 query  => 1);
cleanup
yuki-kimoto authored on 2010-10-17
1566

            
1567
Execute insert statement.
1568
C<insert> method have C<table>, C<param>, C<append>
1569
and C<filter> arguments.
1570
C<table> is a table name.
1571
C<param> is the pairs of column name value. this must be hash reference.
1572
C<append> is a string added at the end of the SQL statement.
1573
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1574
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1575
default to 0. This is experimental.
cleanup
yuki-kimoto authored on 2010-10-17
1576
This is overwrites C<default_bind_filter>.
1577
Return value of C<insert()> is the count of affected rows.
1578

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

            
1581
To insert row by using primary key, use C<insert_at()>
1582

            
1583
    $dbi->insert_at(
1584
        table => 'book',
1585
        primary_key => ['id'],
1586
        where => ['123'],
1587
        param => {name => 'Ken'}
1588
    );
1589

            
1590
In this example, row which id column is 123 is inserted.
1591
NOTE that you must pass array reference as C<where>.
1592
If C<param> contains primary key,
1593
the key and value is delete from C<param>.
1594

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

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

            
1599
Create insert parameter tag.
1600

            
1601
    {title => 'a', age => 2}   ->   {insert_param title age}
1602

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

            
pod fix
Yuki Kimoto authored on 2011-01-21
1605
    $dbi->each_column(
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1606
        sub {
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1607
            my ($self, $table, $column, $column_info) = @_;
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1608
            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1609
            my $type = $column_info->{TYPE_NAME};
pod fix
Yuki Kimoto authored on 2011-01-21
1610
            
1611
            if ($type eq 'DATE') {
1612
                # ...
1613
            }
added experimental iterate_a...
Yuki Kimoto authored on 2010-12-22
1614
        }
1615
    );
pod fix
Yuki Kimoto authored on 2011-01-21
1616
Get column informations from database.
1617
Argument is callback.
1618
You can do anything in callback.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1619
Callback receive four arguments, dbi object, table name,
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1620
column name and column information.
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1621

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1624
    $dbi->include_model(
1625
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1626
            'book', 'person', 'company'
1627
        ]
1628
    );
1629

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

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

            
1636
    $dbi->include_model('MyModel');
1637

            
1638
Note that in this case name spece module is needed.
1639

            
1640
    # MyModel.pm
1641
    package MyModel;
1642
    
1643
    use base 'DBIx::Custom::Model';
1644

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1647
    MyModel::book
1648
    MyModel::person
1649
    MyModel::company
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1650

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

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

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1658
    $dbi->include_model(
1659
        'MyModel' => [
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
1660
            {'book' => 'Book'},
1661
            {'person' => 'Person'}
1662
        ]
1663
    );
1664

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

            
1667
    $dbi->method(
1668
        update_or_insert => sub {
1669
            my $self = shift;
1670
            # do something
1671
        },
1672
        find_or_create   => sub {
1673
            my $self = shift;
1674
            # do something
1675
        }
1676
    );
1677

            
1678
Register method. These method is called from L<DBIx::Custom> object directory.
1679

            
1680
    $dbi->update_or_insert;
1681
    $dbi->find_or_create;
1682

            
1683
=head2 C<new>
1684

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

            
1688
Create a new L<DBIx::Custom> object.
1689

            
1690
=head2 C<(experimental) not_exists>
1691

            
1692
    my $not_exists = $dbi->not_exists;
1693

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1696
=head2 C<register_filter>
1697

            
1698
    $dbi->register_filter(%filters);
1699
    $dbi->register_filter(\%filters);
1700
    
1701
Register filter. Registered filters is available in the following attributes
1702
or arguments.
1703

            
1704
=over 4
1705

            
1706
=item *
1707

            
1708
C<filter> argument of C<insert()>, C<update()>,
1709
C<update_all()>, C<delete()>, C<delete_all()>, C<select()>
1710
methods
1711

            
1712
=item *
1713

            
1714
C<execute()> method
1715

            
1716
=item *
1717

            
1718
C<default_filter> and C<filter> of C<DBIx::Custom::Query>
1719

            
1720
=item *
1721

            
1722
C<default_filter> and C<filter> of C<DBIx::Custom::Result>
1723

            
1724
=back
1725

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

            
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1728
    $dbi->register_tag(
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1729
        limit => sub {
1730
            ...;
1731
        }
1732
    );
1733

            
cleanup
Yuki Kimoto authored on 2011-01-25
1734
Register tag.
added register_tag_processor
Yuki Kimoto authored on 2011-01-20
1735

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

            
1738
    $dbi->rollback;
1739

            
1740
Rollback transaction.
1741
This is same as L<DBI>'s C<rollback>.
1742

            
removed DBIx::Custom commit ...
yuki-kimoto authored on 2010-07-14
1743
=head2 C<select>
packaging one directory
yuki-kimoto authored on 2009-11-16
1744
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
1745
    my $result = $dbi->select(
1746
        table     => $table,
1747
        column    => [@column],
1748
        where     => \%where,
1749
        append    => $append,
1750
        relation  => \%relation,
cleanup
Yuki Kimoto authored on 2011-03-08
1751
        left_join => ['book.company_id' => 'company.id']
select method column option ...
Yuki Kimoto authored on 2011-02-22
1752
        filter    => \%filter,
1753
        query     => 1,
1754
        selection => $selection
1755
    );
update document
yuki-kimoto authored on 2009-11-19
1756

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1757
Execute select statement.
cleanup
yuki-kimoto authored on 2010-08-09
1758
C<select> method have C<table>, C<column>, C<where>, C<append>,
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1759
C<relation> and C<filter> arguments.
1760
C<table> is a table name.
select method column option ...
Yuki Kimoto authored on 2011-02-22
1761
C<column> is column names. this is array reference or string.
cleanup
yuki-kimoto authored on 2010-08-09
1762
C<where> is where clause. this is normally hash reference.
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1763
C<append> is a string added at the end of the SQL statement.
1764
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1765
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1766
default to 0. This is experimental.
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
1767
C<selection> is string of column name and tables. This is experimental
1768

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

            
cleanup
yuki-kimoto authored on 2010-08-09
1772
First element is a string. it contains tags,
1773
such as "{= title} or {like author}".
1774
Second element is paramters.
1775

            
cleanup
Yuki Kimoto authored on 2011-03-08
1776
C<left_join> is add left outer join clause after from clause.
1777
This is experimental.
1778

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1790
    $dbi->update(table  => $table, 
1791
                 param  => \%params,
1792
                 where  => \%where,
1793
                 append => $append,
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
1794
                 filter => \@filter,
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1795
                 query  => 1)
removed reconnect method
yuki-kimoto authored on 2010-05-28
1796

            
cleanup
yuki-kimoto authored on 2010-10-17
1797
Execute update statement.
1798
C<update> method have C<table>, C<param>, C<where>, C<append>
1799
and C<filter> arguments.
1800
C<table> is a table name.
1801
C<param> is column-value pairs. this must be hash reference.
1802
C<where> is where clause. this must be hash reference.
1803
C<append> is a string added at the end of the SQL statement.
1804
C<filter> is filters when parameter binding is executed.
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1805
C<query> is if you don't execute sql and get L<DBIx::Custom::Query> object as return value.
1806
default to 0. This is experimental.
cleanup
yuki-kimoto authored on 2010-10-17
1807
This is overwrites C<default_bind_filter>.
1808
Return value of C<update()> is the count of affected rows.
removed reconnect method
yuki-kimoto authored on 2010-05-28
1809

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

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

            
1814
Create update parameter tag.
1815

            
1816
    {title => 'a', age => 2}   ->   {update_param title age}
1817

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

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1820
    $dbi->model('book')->method(
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1821
        insert => sub { ... },
1822
        update => sub { ... }
1823
    );
1824
    
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1825
    my $model = $dbi->model('book');
remove DBIx::Custom::Model
Yuki Kimoto authored on 2011-01-12
1826

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

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

            
1831
    $dbi->setup_model;
1832

            
1833
Setup all model objects.
1834
C<columns> and C<primary_key> is automatically set.
1835

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

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

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

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

            
1850
To update row by using primary key, use C<update_at()>
1851

            
1852
    $dbi->update_at(
1853
        table => 'book',
1854
        primary_key => ['id'],
1855
        where => ['123'],
1856
        param => {name => 'Ken'}
1857
    );
1858

            
1859
In this example, row which id column is 123 is updated.
1860
NOTE that you must pass array reference as C<where>.
1861
If C<param> contains primary key,
1862
the key and value is delete from C<param>.
1863

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

            
1866
    my $where = $dbi->where;
1867

            
1868
Create a new L<DBIx::Custom::Where> object.
1869

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

            
1872
    $dbi          = $dbi->cache_method(\&cache_method);
1873
    $cache_method = $dbi->cache_method
1874

            
1875
Method to set and get caches.
1876

            
cleanup
Yuki Kimoto authored on 2011-01-25
1877
=head1 Tags
1878

            
1879
The following tags is available.
1880

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

            
1883
Table tag
1884

            
1885
    {table TABLE}    ->    TABLE
1886

            
1887
This is used to teach what is applied table to C<execute()>.
1888

            
cleanup
Yuki Kimoto authored on 2011-01-25
1889
=head2 C<?>
1890

            
1891
Placeholder tag.
1892

            
1893
    {? NAME}    ->   ?
1894

            
1895
=head2 C<=>
1896

            
1897
Equal tag.
1898

            
1899
    {= NAME}    ->   NAME = ?
1900

            
1901
=head2 C<E<lt>E<gt>>
1902

            
1903
Not equal tag.
1904

            
1905
    {<> NAME}   ->   NAME <> ?
1906

            
1907
=head2 C<E<lt>>
1908

            
1909
Lower than tag
1910

            
1911
    {< NAME}    ->   NAME < ?
1912

            
1913
=head2 C<E<gt>>
1914

            
1915
Greater than tag
1916

            
1917
    {> NAME}    ->   NAME > ?
1918

            
1919
=head2 C<E<gt>=>
1920

            
1921
Greater than or equal tag
1922

            
1923
    {>= NAME}   ->   NAME >= ?
1924

            
1925
=head2 C<E<lt>=>
1926

            
1927
Lower than or equal tag
1928

            
1929
    {<= NAME}   ->   NAME <= ?
1930

            
1931
=head2 C<like>
1932

            
1933
Like tag
1934

            
1935
    {like NAME}   ->   NAME like ?
1936

            
1937
=head2 C<in>
1938

            
1939
In tag.
1940

            
1941
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
1942

            
1943
=head2 C<insert_param>
1944

            
1945
Insert parameter tag.
1946

            
1947
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
1948

            
1949
=head2 C<update_param>
1950

            
1951
Updata parameter tag.
1952

            
1953
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
1954

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

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

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

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

            
1964
C<< <kimoto.yuki at gmail.com> >>
1965

            
1966
L<http://github.com/yuki-kimoto/DBIx-Custom>
1967

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1968
=head1 AUTHOR
1969

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

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

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

            
1976
This program is free software; you can redistribute it and/or modify it
1977
under the same terms as Perl itself.
1978

            
1979
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1980

            
1981