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

            
cleanup
Yuki Kimoto authored on 2011-04-02
3
our $VERSION = '0.1671';
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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
150
sub column {
151
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
152
    
cleanup
Yuki Kimoto authored on 2011-04-02
153
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
154
    my $q = $self->reserved_word_quote;
155
    
cleanup
Yuki Kimoto authored on 2011-04-02
156
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-21
157
    my @column;
cleanup
Yuki Kimoto authored on 2011-04-02
158
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
159
    push @column, "$q$table$q.$q$_$q as $q${table}${q}__$q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
160
    
161
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
162
}
163

            
packaging one directory
yuki-kimoto authored on 2009-11-16
164
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
165
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
166
    
cleanup
Yuki Kimoto authored on 2011-04-02
167
    # Connect and get database handle
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
168
    my $dbh = $self->_connect;
packaging one directory
yuki-kimoto authored on 2009-11-16
169
    
cleanup
Yuki Kimoto authored on 2011-04-02
170
    # Set database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
171
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
172
    
cleanup
Yuki Kimoto authored on 2011-04-02
173
    # Set process ID
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
174
    $self->pid($$);
175
    
packaging one directory
yuki-kimoto authored on 2009-11-16
176
    return $self;
177
}
178

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
213
        # Save query to cache
214
        $self->cache_method->(
215
            $self, $source,
216
            {
217
                sql     => $query->sql, 
218
                columns => $query->columns,
219
                tables  => $query->tables
220
            }
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

            
update pod
Yuki Kimoto authored on 2011-03-13
238
sub dbh {
239
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
240
    
241
    # Set
update pod
Yuki Kimoto authored on 2011-03-13
242
    if (@_) {
243
        $self->{dbh} = $_[0];
244
        return $self;
245
    }
cleanup
Yuki Kimoto authored on 2011-04-02
246
    
247
    # Get
update pod
Yuki Kimoto authored on 2011-03-13
248
    else {
249
        my $pid = $$;
cleanup
Yuki Kimoto authored on 2011-04-02
250
        
251
        # Get database handle
update pod
Yuki Kimoto authored on 2011-03-13
252
        if ($self->pid eq $pid) {
253
            return $self->{dbh};
254
        }
cleanup
Yuki Kimoto authored on 2011-04-02
255
        
256
        # Create new database handle in child process
update pod
Yuki Kimoto authored on 2011-03-13
257
        else {
258
            croak "Process is forked in transaction"
259
              unless $self->{dbh}->{AutoCommit};
260
            $self->pid($pid);
261
            $self->{dbh}->{InactiveDestroy} = 1;
262
            return $self->{dbh} = $self->_connect;
263
        }
264
    }
265
}
266

            
cleanup
Yuki Kimoto authored on 2011-03-21
267
our %DELETE_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
268
  = map { $_ => 1 } @COMMON_ARGS, qw/where append allow_delete_all/;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
269

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
273
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
274
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
275
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
276
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
277
    }
278
    
279
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
280
    my $table = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
281
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
282
    my $where            = delete $args{where} || {};
283
    my $append           = delete $args{append};
284
    my $allow_delete_all = delete $args{allow_delete_all};
cleanup
Yuki Kimoto authored on 2011-04-02
285
    my $query_return     = delete $args{query};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
286

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
287
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
288
    $where = $self->_where_to_obj($where);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
289
    
cleanup
Yuki Kimoto authored on 2011-04-02
290
    # Where clause
291
    my $where_clause = $where->to_string;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
292
    croak qq{"where" must be specified}
cleanup
Yuki Kimoto authored on 2011-04-02
293
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
294

            
cleanup
Yuki Kimoto authored on 2011-04-02
295
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
296
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
297
    my $q = $self->reserved_word_quote;
298
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
299
    push @sql, $append if $append;
300
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
301
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
302
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
303
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
304
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
305
    
packaging one directory
yuki-kimoto authored on 2009-11-16
306
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
307
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
308
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
309
        param => $where->param,
cleanup
Yuki Kimoto authored on 2011-03-21
310
        table => $table,
311
        %args
312
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
313
}
314

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

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

            
319
sub delete_at {
320
    my ($self, %args) = @_;
321
    
cleanup
Yuki Kimoto authored on 2011-04-02
322
    # Arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
323
    my $primary_keys = delete $args{primary_key};
324
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-04-02
325
    my $where = delete $args{where};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
326
    
cleanup
Yuki Kimoto authored on 2011-04-02
327
    # Check arguments
328
    foreach my $name (keys %args) {
329
        croak qq{Argument "$name" is wrong name}
330
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
331
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
332
    
cleanup
Yuki Kimoto authored on 2011-04-02
333
    # Where to hash
334
    my $param = {};
335
    if ($where) {
336
        $where = [$where] unless ref $where;
337
        croak qq{"where" must be constant value or array reference}
338
          unless ref $where eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
339
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
340
           $param->{$primary_keys->[$i]} = $where->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
341
        }
342
    }
343
    
cleanup
Yuki Kimoto authored on 2011-04-02
344
    return $self->delete(where => $param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
345
}
346

            
added helper method
yuki-kimoto authored on 2010-10-17
347
sub DESTROY { }
348

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
349
sub create_model {
350
    my $self = shift;
351
    
cleanup
Yuki Kimoto authored on 2011-04-02
352
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
353
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
354
    $args->{dbi} = $self;
355
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
356
    my $model_name  = delete $args->{name};
357
    my $model_table = delete $args->{table};
358
    $model_name ||= $model_table;
359
    
cleanup
Yuki Kimoto authored on 2011-04-02
360
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
361
    my $model = $model_class->new($args);
362
    $model->name($model_name) unless $model->name;
363
    $model->table($model_table) unless $model->table;
364
    
365
    # Apply filter
366
    croak "$model_class filter must be array reference"
367
      unless ref $model->filter eq 'ARRAY';
368
    $self->apply_filter($model->table, @{$model->filter});
369
    
cleanup
Yuki Kimoto authored on 2011-04-02
370
    # Associate table with model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
371
    croak "Table name is duplicated"
372
      if exists $self->{_model_from}->{$model->table};
373
    $self->{_model_from}->{$model->table} = $model->name;
374

            
375
    # Table alias
376
    $self->{_table_alias} ||= {};
377
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
378
    
379
    # Set model
380
    $self->model($model->name, $model);
381
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
382
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
383
}
384

            
385
sub each_column {
386
    my ($self, $cb) = @_;
387
    
388
    # Iterate all tables
389
    my $sth_tables = $self->dbh->table_info;
390
    while (my $table_info = $sth_tables->fetchrow_hashref) {
391
        
392
        # Table
393
        my $table = $table_info->{TABLE_NAME};
394
        
395
        # Iterate all columns
396
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
397
        while (my $column_info = $sth_columns->fetchrow_hashref) {
398
            my $column = $column_info->{COLUMN_NAME};
399
            $self->$cb($table, $column, $column_info);
400
        }
401
    }
402
}
403

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

            
406
sub execute {
cleanup
yuki-kimoto authored on 2010-10-17
407
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
408
    
cleanup
Yuki Kimoto authored on 2011-04-02
409
    # Arguments
cleanup
Yuki Kimoto authored on 2011-04-02
410
    my $param  = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
411
    my $tables = delete $args{table} || [];
412
    $tables = [$tables] unless ref $tables eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-04-02
413
    my $filter = delete $args{filter};
414
    $filter = DBIx::Custom::Util::array_to_hash($filter);
415
    my $type = delete $args{type};
416
    $type = DBIx::Custom::Util::array_to_hash($type);
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
417
    
cleanup
Yuki Kimoto authored on 2011-03-09
418
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
419
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
420
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
421
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
422
    }
423
    
cleanup
Yuki Kimoto authored on 2011-04-02
424
    # Create query
425
    $query = $self->create_query($query) unless ref $query;
cleanup
Yuki Kimoto authored on 2011-04-02
426
    $filter ||= $query->filter;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
427
    
cleanup
Yuki Kimoto authored on 2011-04-02
428
    # Tables
429
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
430
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
431
    $tables = $self->_remove_duplicate_table($tables, $main_table);
432
    if (my $q = $self->reserved_word_quote) {
433
        $_ =~ s/$q//g for @$tables;
434
    }
cleanup
Yuki Kimoto authored on 2011-04-02
435
    
436
    # Table alias
cleanup
Yuki Kimoto authored on 2011-04-02
437
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
438
        
cleanup
Yuki Kimoto authored on 2011-04-02
439
        # No need
440
        next unless my $alias = $self->{_table_alias}->{$table};
441
        $self->{filter} ||= {};
442
        next if $self->{filter}{out}{$table};
443
        
444
        # Filter
445
        $self->{filter}{out} ||= {};
446
        $self->{filter}{in}  ||= {};
447
        $self->{filter}{end} ||= {};
448
        
449
        # Create alias filter
450
        foreach my $type (qw/out in end/) {
451
            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};
452
            foreach my $filter_name (@filter_names) {
453
                my $filter_name_alias = $filter_name;
454
                $filter_name_alias =~ s/^$alias\./$table\./;
455
                $filter_name_alias =~ s/^${alias}__/${table}__/; 
456
                $self->{filter}{$type}{$table}{$filter_name_alias}
457
                  = $self->{filter}{$type}{$alias}{$filter_name}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
458
            }
459
        }
460
    }
cleanup
Yuki Kimoto authored on 2011-04-02
461
    
462
    # Applied filter
463
    my $applied_filter = {};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
464
    foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
465
        $applied_filter = {
466
            %$applied_filter,
cleanup
Yuki Kimoto authored on 2011-01-12
467
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
468
        }
469
    }
cleanup
Yuki Kimoto authored on 2011-04-02
470
    $filter = {%$applied_filter, %$filter};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
471
    
cleanup
Yuki Kimoto authored on 2011-04-02
472
    # Replace filter name to code
473
    foreach my $column (keys %$filter) {
474
        my $name = $filter->{$column};
475
        if (!defined $name) {
476
            $filter->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
477
        }
cleanup
Yuki Kimoto authored on 2011-04-02
478
        elsif (ref $name ne 'CODE') {
479
          croak qq{Filter "$name" is not registered"}
480
            unless exists $self->filters->{$name};
481
          $filter->{$column} = $self->filters->{$name};
cleanup
Yuki Kimoto authored on 2010-12-21
482
        }
483
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
484
    
cleanup
Yuki Kimoto authored on 2011-04-02
485
    # Create bind values
486
    my $bind = $self->_create_bind_values(
487
        $param,
488
        $query->columns,
489
        $filter,
490
        $type
491
    );
cleanup
yuki-kimoto authored on 2010-10-17
492
    
493
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
494
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
495
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
496
    eval {
497
        for (my $i = 0; $i < @$bind; $i++) {
cleanup
Yuki Kimoto authored on 2011-04-02
498
            my $type = $bind->[$i]->{type};
499
            $sth->bind_param($i + 1, $bind->[$i]->{value}, $type ? $type : ());
cleanup
Yuki Kimoto authored on 2011-03-21
500
        }
501
        $affected = $sth->execute;
502
    };
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
503
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
504
    
cleanup
Yuki Kimoto authored on 2011-04-02
505
    # Select statement
cleanup
yuki-kimoto authored on 2010-10-17
506
    if ($sth->{NUM_OF_FIELDS}) {
507
        
cleanup
Yuki Kimoto authored on 2011-04-02
508
        # Filter
509
        my $filter = {};
510
        $filter->{in}  = {};
511
        $filter->{end} = {};
cleanup
Yuki Kimoto authored on 2011-01-12
512
        foreach my $table (@$tables) {
cleanup
Yuki Kimoto authored on 2011-04-02
513
            foreach my $way (qw/in end/) {
514
                $filter->{$way} = {
515
                    %{$filter->{$way}},
516
                    %{$self->{filter}{$way}{$table} || {}}
517
                };
518
            }
cleanup
Yuki Kimoto authored on 2011-01-12
519
        }
520
        
521
        # Result
522
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
523
            sth            => $sth,
524
            filters        => $self->filters,
525
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
526
            default_filter => $self->{default_in_filter},
cleanup
Yuki Kimoto authored on 2011-04-02
527
            filter         => $filter->{in} || {},
528
            end_filter     => $filter->{end} || {}
cleanup
yuki-kimoto authored on 2010-10-17
529
        );
530

            
531
        return $result;
532
    }
cleanup
Yuki Kimoto authored on 2011-04-02
533
    
534
    # Not select statement
535
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
536
}
537

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

            
cleanup
yuki-kimoto authored on 2010-10-17
540
sub insert {
541
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
542
    
cleanup
yuki-kimoto authored on 2010-10-17
543
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
544
    my $table  = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
545
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
546
    my $param  = delete $args{param} || {};
547
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
548
    my $query_return  = delete $args{query};
549

            
550
    # Check arguments
551
    foreach my $name (keys %args) {
552
        croak qq{Argument "$name" is wrong name}
553
          unless $INSERT_ARGS{$name};
554
    }
555

            
556
    # Reserved word quote
557
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
558
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
559
    # Columns
560
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
561
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
562
    foreach my $column (keys %$param) {
563
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
564
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
565
          $column = "$q$column$q";
566
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
567
        push @columns, $column;
568
    }
cleanup
yuki-kimoto authored on 2010-10-17
569
    
cleanup
Yuki Kimoto authored on 2011-04-02
570
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
571
    my @sql;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
572
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
573
    push @sql, $append if $append;
574
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
575
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
576
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
577
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
578
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
579
    
packaging one directory
yuki-kimoto authored on 2009-11-16
580
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
581
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
582
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
583
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
584
        table => $table,
585
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
586
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
587
}
588

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

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

            
594
    # Arguments
595
    my $primary_keys = delete $args{primary_key};
596
    $primary_keys = [$primary_keys] unless ref $primary_keys;
597
    my $where = delete $args{where};
598
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
599
    
cleanup
Yuki Kimoto authored on 2011-04-02
600
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
601
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
602
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
603
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
604
    }
605
    
cleanup
Yuki Kimoto authored on 2011-04-02
606
    # Where
607
    my $where_param = {};
608
    if ($where) {
609
        $where = [$where] unless ref $where;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
610
        croak qq{"where" must be constant value or array reference}
cleanup
Yuki Kimoto authored on 2011-04-02
611
          unless !ref $where || ref $where eq 'ARRAY';
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
612
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
613
           $where_param->{$primary_keys->[$i]} = $where->[$i];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
614
        }
615
    }
cleanup
Yuki Kimoto authored on 2011-04-02
616
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
617
    
618
    return $self->insert(param => $param, %args);
619
}
620

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
621
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
622
    my ($self, $param) = @_;
623
    
cleanup
Yuki Kimoto authored on 2011-04-02
624
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
625
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
626
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
627
    my @columns;
628
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
629
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
630
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
631
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
632
        $column = "$q$column$q";
633
        $column =~ s/\./$q.$q/;
634
        push @columns, $column;
635
        push @placeholders, "{? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
636
    }
637
    
cleanup
Yuki Kimoto authored on 2011-04-02
638
    return '(' . join(', ', @columns) . ') ' . 'values ' .
639
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
640
}
641

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
642
sub include_model {
643
    my ($self, $name_space, $model_infos) = @_;
644
    
cleanup
Yuki Kimoto authored on 2011-04-02
645
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
646
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
647
    
648
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
649
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
650

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
651
        # Load name space module
652
        croak qq{"$name_space" is invalid class name}
653
          if $name_space =~ /[^\w:]/;
654
        eval "use $name_space";
655
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
656
        
657
        # Search model modules
658
        my $path = $INC{"$name_space.pm"};
659
        $path =~ s/\.pm$//;
660
        opendir my $dh, $path
661
          or croak qq{Can't open directory "$path": $!};
662
        $model_infos = [];
663
        while (my $module = readdir $dh) {
664
            push @$model_infos, $module
665
              if $module =~ s/\.pm$//;
666
        }
667
        close $dh;
668
    }
669
    
cleanup
Yuki Kimoto authored on 2011-04-02
670
    # Include models
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
671
    foreach my $model_info (@$model_infos) {
672
        
cleanup
Yuki Kimoto authored on 2011-04-02
673
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
674
        my $model_class;
675
        my $model_name;
676
        my $model_table;
677
        if (ref $model_info eq 'HASH') {
678
            $model_class = $model_info->{class};
679
            $model_name  = $model_info->{name};
680
            $model_table = $model_info->{table};
681
            
682
            $model_name  ||= $model_class;
683
            $model_table ||= $model_name;
684
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
685
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
686
        my $mclass = "${name_space}::$model_class";
687
        croak qq{"$mclass" is invalid class name}
688
          if $mclass =~ /[^\w:]/;
689
        unless ($mclass->can('isa')) {
690
            eval "use $mclass";
691
            croak $@ if $@;
692
        }
693
        
cleanup
Yuki Kimoto authored on 2011-04-02
694
        # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
695
        my $args = {};
696
        $args->{model_class} = $mclass if $mclass;
697
        $args->{name}        = $model_name if $model_name;
698
        $args->{table}       = $model_table if $model_table;
699
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
700
    }
701
    
702
    return $self;
703
}
704

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
705
sub merge_param {
706
    my ($self, @params) = @_;
707
    
cleanup
Yuki Kimoto authored on 2011-04-02
708
    # Merge parameters
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
709
    my $param = {};
710
    foreach my $p (@params) {
711
        foreach my $column (keys %$p) {
712
            if (exists $param->{$column}) {
713
                $param->{$column} = [$param->{$column}]
714
                  unless ref $param->{$column} eq 'ARRAY';
715
                push @{$param->{$column}}, $p->{$column};
716
            }
717
            else {
718
                $param->{$column} = $p->{$column};
719
            }
720
        }
721
    }
722
    
723
    return $param;
724
}
725

            
cleanup
Yuki Kimoto authored on 2011-03-21
726
sub method {
727
    my $self = shift;
728
    
cleanup
Yuki Kimoto authored on 2011-04-02
729
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
730
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
731
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
732
    
733
    return $self;
734
}
735

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
736
sub model {
737
    my ($self, $name, $model) = @_;
738
    
cleanup
Yuki Kimoto authored on 2011-04-02
739
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
740
    if ($model) {
741
        $self->models->{$name} = $model;
742
        return $self;
743
    }
744
    
745
    # Check model existance
746
    croak qq{Model "$name" is not included}
747
      unless $self->models->{$name};
748
    
cleanup
Yuki Kimoto authored on 2011-04-02
749
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
750
    return $self->models->{$name};
751
}
752

            
cleanup
Yuki Kimoto authored on 2011-03-21
753
sub mycolumn {
754
    my ($self, $table, $columns) = @_;
755
    
cleanup
Yuki Kimoto authored on 2011-04-02
756
    # Create column clause
757
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
758
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
759
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
760
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
761
    
762
    return join (', ', @column);
763
}
764

            
added dbi_options attribute
kimoto authored on 2010-12-20
765
sub new {
766
    my $self = shift->SUPER::new(@_);
767
    
cleanup
Yuki Kimoto authored on 2011-04-02
768
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
769
    my @attrs = keys %$self;
770
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-02
771
        croak qq{"$attr" is wrong name}
added dbi_options attribute
kimoto authored on 2010-12-20
772
          unless $self->can($attr);
773
    }
cleanup
Yuki Kimoto authored on 2011-04-02
774
    
775
    # Register tag
cleanup
Yuki Kimoto authored on 2011-01-25
776
    $self->register_tag(
777
        '?'     => \&DBIx::Custom::Tag::placeholder,
778
        '='     => \&DBIx::Custom::Tag::equal,
779
        '<>'    => \&DBIx::Custom::Tag::not_equal,
780
        '>'     => \&DBIx::Custom::Tag::greater_than,
781
        '<'     => \&DBIx::Custom::Tag::lower_than,
782
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
783
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
784
        'like'  => \&DBIx::Custom::Tag::like,
785
        'in'    => \&DBIx::Custom::Tag::in,
786
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
787
        'update_param' => \&DBIx::Custom::Tag::update_param
788
    );
added dbi_options attribute
kimoto authored on 2010-12-20
789
    
790
    return $self;
791
}
792

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

            
cleanup
yuki-kimoto authored on 2010-10-17
795
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
796
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
797
    
798
    # Register filter
799
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
800
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
801
    
cleanup
Yuki Kimoto authored on 2011-04-02
802
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
803
}
packaging one directory
yuki-kimoto authored on 2009-11-16
804

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
807
sub replace {
808
    my ($self, $join, $search, $replace) = @_;
809
    
cleanup
Yuki Kimoto authored on 2011-04-02
810
    # Replace
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
811
    my @replace_join;
812
    my $is_replaced;
813
    foreach my $j (@$join) {
814
        if ($search eq $j) {
815
            push @replace_join, $replace;
816
            $is_replaced = 1;
817
        }
818
        else {
819
            push @replace_join, $j;
820
        }
821
    }
822
    croak qq{Can't replace "$search" with "$replace"} unless $is_replaced;
823
    
824
    return @replace_join;
825
}
826

            
cleanup
Yuki Kimoto authored on 2011-03-21
827
our %SELECT_ARGS
cleanup
Yuki Kimoto authored on 2011-04-01
828
  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation join param/;
refactoring select
yuki-kimoto authored on 2010-04-28
829

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
833
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
834
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
835
    my $tables = ref $table eq 'ARRAY' ? $table
836
               : defined $table ? [$table]
837
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
838
    my $columns   = delete $args{column};
839
    my $where     = delete $args{where} || {};
840
    my $append    = delete $args{append};
841
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
842
    croak qq{"join" must be array reference}
843
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
844
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
845
    my $param = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
846
    my $query_return = $args{query};
847

            
848
    # Check arguments
849
    foreach my $name (keys %args) {
850
        croak qq{Argument "$name" is wrong name}
851
          unless $SELECT_ARGS{$name};
852
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
853
    
cleanup
Yuki Kimoto authored on 2011-03-09
854
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
855
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
856
    
cleanup
Yuki Kimoto authored on 2011-04-02
857
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
858
    my @sql;
859
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
860
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
861
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
862
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
863
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
864
        foreach my $column (@$columns) {
cleanup
Yuki Kimoto authored on 2011-04-02
865
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
866
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
867
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
868
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
869
    }
870
    else { push @sql, '*' }
871
    
872
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
873
    push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-04-02
874
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-30
875
    if ($relation) {
876
        my $found = {};
877
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
878
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
879
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
880
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
881
    }
cleanup
Yuki Kimoto authored on 2011-03-30
882
    else {
883
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
884
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
885
    }
886
    pop @sql if ($sql[-1] || '') eq ',';
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
887
    croak "Not found table name" unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
888

            
cleanup
Yuki Kimoto authored on 2011-04-02
889
    # Add tables in parameter
890
    unshift @$tables, @{$self->_search_tables(join(' ', keys %$param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
891
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
892
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
893
    $where = $self->_where_to_obj($where);
894
    $param = keys %$param ? $self->merge_param($param, $where->param)
895
                          : $where->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
896
    
897
    # String where
cleanup
Yuki Kimoto authored on 2011-04-02
898
    my $where_clause = $where->to_string;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
899
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
900
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
901
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
902
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
903
    # Push join
904
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
905
    
cleanup
Yuki Kimoto authored on 2011-03-09
906
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
907
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
908
    
cleanup
Yuki Kimoto authored on 2011-03-08
909
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
910
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
911
    
cleanup
Yuki Kimoto authored on 2011-04-02
912
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
913
    push @sql, $append if $append;
914
    
915
    # SQL
916
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
917
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
918
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
919
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
920
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
921
    
packaging one directory
yuki-kimoto authored on 2009-11-16
922
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
923
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
924
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
925
        param => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
926
        table => $tables,
927
        %args
928
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
929
    
930
    return $result;
931
}
932

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

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

            
938
    # Arguments
939
    my $primary_keys = delete $args{primary_key};
940
    $primary_keys = [$primary_keys] unless ref $primary_keys;
941
    my $where = delete $args{where};
942
    my $param = delete $args{param};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
943
    
cleanup
Yuki Kimoto authored on 2011-04-02
944
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
945
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
946
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
947
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
948
    }
949
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
950
    # Table
951
    croak qq{"table" option must be specified} unless $args{table};
952
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
953
    
cleanup
Yuki Kimoto authored on 2011-04-02
954
    # Where
955
    my $where_param = {};
956
    if ($where) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
957
        croak qq{"where" must be constant value or array reference}
cleanup
Yuki Kimoto authored on 2011-04-02
958
          unless !ref $where || ref $where eq 'ARRAY';
959
        $where = [$where] unless ref $where;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
960
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
961
           $where_param->{$table . '.' . $primary_keys->[$i]} = $where->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
962
        }
963
    }
964
    
cleanup
Yuki Kimoto authored on 2011-04-02
965
    return $self->select(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
966
}
967

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
968
sub setup_model {
969
    my $self = shift;
970
    
cleanup
Yuki Kimoto authored on 2011-04-02
971
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
972
    $self->each_column(
973
        sub {
974
            my ($self, $table, $column, $column_info) = @_;
975
            if (my $model = $self->models->{$table}) {
976
                push @{$model->columns}, $column;
977
            }
978
        }
979
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
980
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
981
}
982

            
cleanup
Yuki Kimoto authored on 2011-03-21
983
our %UPDATE_ARGS
984
  = map { $_ => 1 } @COMMON_ARGS, qw/param where append allow_update_all/;
cleanup
yuki-kimoto authored on 2010-10-17
985

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

            
cleanup
yuki-kimoto authored on 2010-10-17
989
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
990
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
991
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
992
    my $param            = delete $args{param} || {};
993
    my $where            = delete $args{where} || {};
994
    my $append           = delete $args{append} || '';
995
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
996
    
cleanup
Yuki Kimoto authored on 2011-04-02
997
    # Check argument names
998
    foreach my $name (keys %args) {
999
        croak qq{Argument "$name" is wrong name}
1000
          unless $UPDATE_ARGS{$name};
1001
    }
1002
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1003
    # Columns
1004
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1005
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
1006
    my $q = $self->reserved_word_quote;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1007
    foreach my $column (keys %$param) {
1008
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1009
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1010
          $column = "$q$column$q";
1011
          $column =~ s/\./$q.$q/;
1012
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1013
    }
1014
        
cleanup
yuki-kimoto authored on 2010-10-17
1015
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1016
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1017

            
1018
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
1019
    $where = $self->_where_to_obj($where);
1020
    my $where_clause = $where->to_string;
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1021
    croak qq{"where" must be specified}
cleanup
Yuki Kimoto authored on 2011-04-02
1022
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1023
    
cleanup
Yuki Kimoto authored on 2011-04-02
1024
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1025
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
1026
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1027
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1028
    
cleanup
Yuki Kimoto authored on 2011-04-02
1029
    # Merge parameters
1030
    $param = $self->merge_param($param, $where->param);
cleanup
yuki-kimoto authored on 2010-10-17
1031
    
cleanup
Yuki Kimoto authored on 2011-01-27
1032
    # SQL
1033
    my $sql = join(' ', @sql);
1034
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1035
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1036
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1037
    return $query if $args{query};
1038
    
cleanup
yuki-kimoto authored on 2010-10-17
1039
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1040
    my $ret_val = $self->execute(
1041
        $query,
1042
        param  => $param, 
1043
        table => $table,
1044
        %args
1045
    );
cleanup
yuki-kimoto authored on 2010-10-17
1046
    
1047
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1048
}
1049

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

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

            
1054
sub update_at {
1055
    my ($self, %args) = @_;
1056
    
cleanup
Yuki Kimoto authored on 2011-03-09
1057
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1058
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1059
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1060
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1061
    }
1062
    
1063
    # Primary key
1064
    my $primary_keys = delete $args{primary_key};
1065
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1066
    
1067
    # Where clause
1068
    my $where = {};
1069
    my $param = {};
1070
    
1071
    if (exists $args{where}) {
1072
        my $where_columns = delete $args{where};
1073
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1074

            
1075
        croak qq{"where" must be constant value or array reference}
1076
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1077
        
1078
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1079
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1080
        }
1081
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1082
    
1083
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1084
        $param = delete $args{param};
1085
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1086
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1087
        }
1088
    }
1089
    
1090
    return $self->update(where => $where, param => $param, %args);
1091
}
1092

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1093
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1094
    my ($self, $param, $opt) = @_;
1095
    
1096
    # Insert parameter tag
1097
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1098
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1099
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1100
    my $q = $self->reserved_word_quote;
1101
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1102
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1103
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1104
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1105
        
1106
        my $c = "$q$column$q";
1107
        $c =~ s/\./$q.$q/;
1108
        
1109
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1110
    }
1111
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1112
    my $clause;
1113
    $clause .= 'set ' unless $opt->{no_set};
1114
    $clause .= join(', ', @params);
1115
    
1116
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1117
}
1118

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

            
1122
    return DBIx::Custom::Where->new(
1123
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1124
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1125
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1126
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1127
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1128
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1129

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

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1177
sub _connect {
1178
    my $self = shift;
1179
    
1180
    # Attributes
1181
    my $data_source = $self->data_source;
1182
    croak qq{"data_source" must be specified to connect()"}
1183
      unless $data_source;
1184
    my $user        = $self->user;
1185
    my $password    = $self->password;
1186
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1187
    
1188
    # Connect
1189
    my $dbh = eval {DBI->connect(
1190
        $data_source,
1191
        $user,
1192
        $password,
1193
        {
1194
            %{$self->default_dbi_option},
1195
            %$dbi_option
1196
        }
1197
    )};
1198
    
1199
    # Connect error
1200
    croak $@ if $@;
1201
    
1202
    return $dbh;
1203
}
1204

            
cleanup
yuki-kimoto authored on 2010-10-17
1205
sub _croak {
1206
    my ($self, $error, $append) = @_;
1207
    $append ||= "";
1208
    
1209
    # Verbose
1210
    if ($Carp::Verbose) { croak $error }
1211
    
1212
    # Not verbose
1213
    else {
1214
        
1215
        # Remove line and module infromation
1216
        my $at_pos = rindex($error, ' at ');
1217
        $error = substr($error, 0, $at_pos);
1218
        $error =~ s/\s+$//;
1219
        
1220
        croak "$error$append";
1221
    }
1222
}
1223

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1224
sub _need_tables {
1225
    my ($self, $tree, $need_tables, $tables) = @_;
1226
    
1227
    foreach my $table (@$tables) {
1228
        
1229
        if ($tree->{$table}) {
1230
            $need_tables->{$table} = 1;
1231
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1232
        }
1233
    }
1234
}
1235

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1236
sub _push_join {
1237
    my ($self, $sql, $join, $join_tables) = @_;
1238
    
1239
    return unless @$join;
1240
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1241
    my $q = $self->reserved_word_quote;
1242
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1243
    my $tree = {};
1244
    
1245
    for (my $i = 0; $i < @$join; $i++) {
1246
        
1247
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1248
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1249
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1250
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1251
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1252
            
1253
            my $table1 = $1;
1254
            my $table2 = $2;
1255
            
1256
            croak qq{right side table of "$join_clause" must be uniq}
1257
              if exists $tree->{$table2};
1258
            
1259
            $tree->{$table2}
1260
              = {position => $i, parent => $table1, join => $join_clause};
1261
        }
1262
        else {
1263
            croak qq{join "$join_clause" must be two table name};
1264
        }
1265
    }
1266
    
1267
    my $need_tables = {};
1268
    $self->_need_tables($tree, $need_tables, $join_tables);
1269
    
1270
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1271

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1272
    foreach my $need_table (@need_tables) {
1273
        push @$sql, $tree->{$need_table}{join};
1274
    }
1275
}
cleanup
Yuki Kimoto authored on 2011-03-08
1276

            
cleanup
Yuki Kimoto authored on 2011-04-02
1277
sub _remove_duplicate_table {
1278
    my ($self, $tables, $main_table) = @_;
1279
    
1280
    # Remove duplicate table
1281
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1282
    delete $tables{$main_table} if $main_table;
1283
    
1284
    return [keys %tables, $main_table ? $main_table : ()];
1285
}
1286

            
cleanup
Yuki Kimoto authored on 2011-04-02
1287
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1288
    my ($self, $source) = @_;
1289
    
1290
    my $tables = [];
1291
    
1292
    my $safety_character = $self->safety_character;
1293
    my $q = $self->reserved_word_quote;
1294
    my $q_re = quotemeta($q);
1295
    
1296
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1297
                      : qr/\b([$safety_character]+)\./;
1298
    while ($source =~ /$table_re/g) {
1299
        push @$tables, $1;
1300
    }
1301
    
1302
    return $tables;
1303
}
1304

            
cleanup
Yuki Kimoto authored on 2011-04-02
1305
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1306
    my ($self, $where) = @_;
1307
    
1308
    my $w;
1309
    if (ref $where eq 'HASH') {
1310
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1311
        my $q = $self->reserved_word_quote;
1312
        foreach my $column (keys %$where) {
1313
            $column = "$q$column$q";
1314
            $column =~ s/\./$q.$q/;
1315
            push @$clause, "{= $column}" for keys %$where;
1316
        }
1317
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1318
        $w = $self->where(clause => $clause, param => $where);
1319
    }
1320
    elsif (ref $where eq 'DBIx::Custom::Where') {
1321
        $w = $where;
1322
    }
1323
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1324
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1325
             "use \$dbi->select(where => \$dbi->where(clause => " .
1326
             "CLAUSE, param => PARAMETER));";
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1327
        $w = $self->where(
1328
            clause => $where->[0],
1329
            param  => $where->[1]
1330
        );
1331
    }
1332
    
1333
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1334
          qq{or array reference, which contains where clause and paramter}
1335
      unless ref $w eq 'DBIx::Custom::Where';
1336
    
1337
    return $w;
1338
}
1339

            
cleanup
Yuki Kimoto authored on 2011-01-25
1340
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1341
__PACKAGE__->attr(
1342
    dbi_options => sub { {} },
1343
    filter_check  => 1
1344
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1345

            
cleanup
Yuki Kimoto authored on 2011-01-25
1346
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1347
sub default_bind_filter {
1348
    my $self = shift;
1349
    
1350
    if (@_) {
1351
        my $fname = $_[0];
1352
        
1353
        if (@_ && !$fname) {
1354
            $self->{default_out_filter} = undef;
1355
        }
1356
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1357
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1358
              unless exists $self->filters->{$fname};
1359
        
1360
            $self->{default_out_filter} = $self->filters->{$fname};
1361
        }
1362
        return $self;
1363
    }
1364
    
1365
    return $self->{default_out_filter};
1366
}
1367

            
cleanup
Yuki Kimoto authored on 2011-01-25
1368
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1369
sub default_fetch_filter {
1370
    my $self = shift;
1371
    
1372
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1373
        my $fname = $_[0];
1374

            
cleanup
Yuki Kimoto authored on 2011-01-12
1375
        if (@_ && !$fname) {
1376
            $self->{default_in_filter} = undef;
1377
        }
1378
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1379
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1380
              unless exists $self->filters->{$fname};
1381
        
1382
            $self->{default_in_filter} = $self->filters->{$fname};
1383
        }
1384
        
1385
        return $self;
1386
    }
1387
    
many changed
Yuki Kimoto authored on 2011-01-23
1388
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1389
}
1390

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1391
# DEPRECATED!
1392
sub insert_param {
1393
    warn "insert_param is renamed to insert_param_tag."
1394
       . " insert_param is DEPRECATED!";
1395
    return shift->insert_param_tag(@_);
1396
}
1397

            
cleanup
Yuki Kimoto authored on 2011-01-25
1398
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1399
sub register_tag_processor {
1400
    return shift->query_builder->register_tag_processor(@_);
1401
}
1402

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1403
# DEPRECATED!
1404
sub update_param {
1405
    warn "update_param is renamed to update_param_tag."
1406
       . " update_param is DEPRECATED!";
1407
    return shift->update_param_tag(@_);
1408
}
cleanup
Yuki Kimoto authored on 2011-03-08
1409
# DEPRECATED!
1410
sub _push_relation {
1411
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1412
    
1413
    if (keys %{$relation || {}}) {
1414
        push @$sql, $need_where ? 'where' : 'and';
1415
        foreach my $rcolumn (keys %$relation) {
1416
            my $table1 = (split (/\./, $rcolumn))[0];
1417
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1418
            push @$tables, ($table1, $table2);
1419
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1420
        }
1421
    }
1422
    pop @$sql if $sql->[-1] eq 'and';    
1423
}
1424

            
1425
# DEPRECATED!
1426
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1427
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1428
    
1429
    if (keys %{$relation || {}}) {
1430
        foreach my $rcolumn (keys %$relation) {
1431
            my $table1 = (split (/\./, $rcolumn))[0];
1432
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1433
            my $table1_exists;
1434
            my $table2_exists;
1435
            foreach my $table (@$tables) {
1436
                $table1_exists = 1 if $table eq $table1;
1437
                $table2_exists = 1 if $table eq $table2;
1438
            }
1439
            unshift @$tables, $table1 unless $table1_exists;
1440
            unshift @$tables, $table2 unless $table2_exists;
1441
        }
1442
    }
1443
}
1444

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1447
=head1 NAME
1448

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

            
1451
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1452

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1453
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1454
    
1455
    # Connect
1456
    my $dbi = DBIx::Custom->connect(
1457
        data_source => "dbi:mysql:database=dbname",
1458
        user => 'ken',
1459
        password => '!LFKD%$&',
1460
        dbi_option => {mysql_enable_utf8 => 1}
1461
    );
cleanup
yuki-kimoto authored on 2010-08-05
1462

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1463
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1464
    $dbi->insert(
1465
        table  => 'book',
1466
        param  => {title => 'Perl', author => 'Ken'}
1467
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1468
    
1469
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1470
    $dbi->update(
1471
        table  => 'book', 
1472
        param  => {title => 'Perl', author => 'Ken'}, 
1473
        where  => {id => 5},
1474
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1475
    
1476
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1477
    $dbi->delete(
1478
        table  => 'book',
1479
        where  => {author => 'Ken'},
1480
    );
cleanup
yuki-kimoto authored on 2010-08-05
1481

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1488
    # Select, more complex
1489
    my $result = $dbi->select(
1490
        table  => 'book',
1491
        column => [
1492
            'book.author as book__author',
1493
            'company.name as company__name'
1494
        ],
1495
        where  => {'book.author' => 'Ken'},
1496
        join => ['left outer join company on book.company_id = company.id'],
1497
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1498
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1499
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1500
    # Fetch
1501
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1502
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1503
    }
1504
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1505
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1506
    while (my $row = $result->fetch_hash) {
1507
        
1508
    }
1509
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1510
    # Execute SQL with parameter.
1511
    $dbi->execute(
1512
        "select id from book where {= author} and {like title}",
1513
        param  => {author => 'ken', title => '%Perl%'}
1514
    );
1515
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1516
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1517

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

            
1520
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1521

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1526
There are many basic methods to execute various queries.
1527
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1528
C<delete_all()>, C<select()>,
1529
C<insert_at()>, C<update_at()>, 
1530
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1531

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1532
=item *
1533

            
1534
Filter when data is send or receive.
1535

            
1536
=item *
1537

            
1538
Data filtering system
1539

            
1540
=item *
1541

            
1542
Model support.
1543

            
1544
=item *
1545

            
1546
Generate where clause dinamically.
1547

            
1548
=item *
1549

            
1550
Generate join clause dinamically.
1551

            
1552
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1553

            
1554
=head1 GUIDE
1555

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

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

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

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

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

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

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

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

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

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

            
1579
=head2 C<default_dbi_option>
1580

            
1581
    my $default_dbi_option = $dbi->default_dbi_option;
1582
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1583

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1587
    {
1588
        RaiseError => 1,
1589
        PrintError => 0,
1590
        AutoCommit => 1,
1591
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1592

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1603
=head2 C<models> EXPERIMENTAL
add models() attribute
Yuki Kimoto authored on 2011-02-21
1604

            
1605
    my $models = $dbi->models;
1606
    $dbi       = $dbi->models(\%models);
1607

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1610
=head2 C<password>
1611

            
1612
    my $password = $dbi->password;
1613
    $dbi         = $dbi->password('lkj&le`@s');
1614

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

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

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

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

            
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1624
=head2 C<reserved_word_quote> EXPERIMENTAL
1625

            
1626
     my reserved_word_quote = $dbi->reserved_word_quote;
1627
     $dbi                   = $dbi->reserved_word_quote('"');
1628

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1648
    my $user = $dbi->user;
1649
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1650

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1659
=head2 C<apply_filter> EXPERIMENTAL
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1660

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1661
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1662
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1663
        'issue_date' => {
1664
            out => 'tp_to_date',
1665
            in  => 'date_to_tp',
1666
            end => 'tp_to_displaydate'
1667
        },
1668
        'write_date' => {
1669
            out => 'tp_to_date',
1670
            in  => 'date_to_tp',
1671
            end => 'tp_to_displaydate'
1672
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1673
    );
1674

            
update pod
Yuki Kimoto authored on 2011-03-13
1675
Apply filter to columns.
1676
C<out> filter is executed before data is send to database.
1677
C<in> filter is executed after a row is fetch.
1678
C<end> filter is execute after C<in> filter is executed.
1679

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1682
       PETTERN         EXAMPLE
1683
    1. Column        : author
1684
    2. Table.Column  : book.author
1685
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1686

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

            
1690
You can set multiple filters at once.
1691

            
1692
    $dbi->apply_filter(
1693
        'book',
1694
        [qw/issue_date write_date/] => {
1695
            out => 'tp_to_date',
1696
            in  => 'date_to_tp',
1697
            end => 'tp_to_displaydate'
1698
        }
1699
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1700

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1703
    my $dbi = DBIx::Custom->connect(
1704
        data_source => "dbi:mysql:database=dbname",
1705
        user => 'ken',
1706
        password => '!LFKD%$&',
1707
        dbi_option => {mysql_enable_utf8 => 1}
1708
    );
1709

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1718
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1719
        table => 'book',
1720
        primary_key => 'id',
1721
        join => [
1722
            'inner join company on book.comparny_id = company.id'
1723
        ],
1724
        filter => [
1725
            publish_date => {
1726
                out => 'tp_to_date',
1727
                in => 'date_to_tp',
1728
                end => 'tp_to_displaydate'
1729
            }
1730
        ]
1731
    );
1732

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

            
1736
   $dbi->model('book')->select(...);
1737

            
cleanup
yuki-kimoto authored on 2010-10-17
1738
=head2 C<create_query>
1739
    
1740
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1741
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1742
    );
update document
yuki-kimoto authored on 2009-11-19
1743

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

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

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

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

            
1754
    my $dbh = $dbi->dbh;
1755
    $dbi    = $dbi->dbh($dbh);
1756

            
1757
Get and set database handle of L<DBI>.
1758

            
update pod
Yuki Kimoto authored on 2011-03-13
1759
If process is spawn by forking, new connection is created automatically.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1760

            
1761
=head2 C<each_column>
1762

            
1763
    $dbi->each_column(
1764
        sub {
1765
            my ($dbi, $table, $column, $column_info) = @_;
1766
            
1767
            my $type = $column_info->{TYPE_NAME};
1768
            
1769
            if ($type eq 'DATE') {
1770
                # ...
1771
            }
1772
        }
1773
    );
1774

            
1775
Iterate all column informations of all table from database.
1776
Argument is callback when one column is found.
1777
Callback receive four arguments, dbi object, table name,
1778
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1779

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1782
    my $result = $dbi->execute(
1783
        "select * from book where {= title} and {like author}",
1784
        param => {title => 'Perl', author => '%Ken%'}
1785
    );
1786

            
1787
Execute SQL, containing tags.
1788
Return value is L<DBIx::Custom::Result> in select statement, or
1789
the count of affected rows in insert, update, delete statement.
1790

            
1791
Tag is turned into the statement containing place holder
1792
before SQL is executed.
1793

            
1794
    select * from where title = ? and author like ?;
1795

            
1796
See also L<Tags/Tags>.
1797

            
1798
The following opitons are currently available.
1799

            
1800
=over 4
1801

            
1802
=item C<filter>
1803

            
1804
Filter, executed before data is send to database. This is array reference.
1805
Filter value is code reference or
1806
filter name registerd by C<register_filter()>.
1807

            
1808
    # Basic
1809
    $dbi->execute(
1810
        $sql,
1811
        filter => [
1812
            title  => sub { uc $_[0] }
1813
            author => sub { uc $_[0] }
1814
        ]
1815
    );
1816
    
1817
    # At once
1818
    $dbi->execute(
1819
        $sql,
1820
        filter => [
1821
            [qw/title author/]  => sub { uc $_[0] }
1822
        ]
1823
    );
1824
    
1825
    # Filter name
1826
    $dbi->execute(
1827
        $sql,
1828
        filter => [
1829
            title  => 'upper_case',
1830
            author => 'upper_case'
1831
        ]
1832
    );
1833

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

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

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

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

            
1842
Delete statement.
1843

            
1844
The following opitons are currently available.
1845

            
update pod
Yuki Kimoto authored on 2011-03-13
1846
=over 4
1847

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

            
1850
Table name.
1851

            
1852
    $dbi->delete(table => 'book');
1853

            
1854
=item C<where>
1855

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1856
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1857
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1858
    
1859
    # Hash reference
1860
    $dbi->delete(where => {title => 'Perl'});
1861
    
1862
    # DBIx::Custom::Where object
1863
    my $where = $dbi->where(
1864
        clause => ['and', '{= author}', '{like title}'],
1865
        param  => {author => 'Ken', title => '%Perl%'}
1866
    );
1867
    $dbi->delete(where => $where);
1868

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1869
    # Array refrendce (where clause and parameter)
1870
    $dbi->delete(where =>
1871
        [
1872
            ['and', '{= author}', '{like title}'],
1873
            {author => 'Ken', title => '%Perl%'}
1874
        ]
1875
    );
1876
    
update pod
Yuki Kimoto authored on 2011-03-13
1877
=item C<append>
1878

            
1879
Append statement to last of SQL. This is string.
1880

            
1881
    $dbi->delete(append => 'order by title');
1882

            
1883
=item C<filter>
1884

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

            
1889
    # Basic
1890
    $dbi->delete(
1891
        filter => [
1892
            title  => sub { uc $_[0] }
1893
            author => sub { uc $_[0] }
1894
        ]
1895
    );
1896
    
1897
    # At once
1898
    $dbi->delete(
1899
        filter => [
1900
            [qw/title author/]  => sub { uc $_[0] }
1901
        ]
1902
    );
1903
    
1904
    # Filter name
1905
    $dbi->delete(
1906
        filter => [
1907
            title  => 'upper_case',
1908
            author => 'upper_case'
1909
        ]
1910
    );
1911

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
1914
=head2 C<column> EXPERIMENTAL
1915

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

            
1918
Create column clause. The follwoing column clause is created.
1919

            
1920
    book.author as book__author,
1921
    book.title as book__title
1922

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

            
1925
Get L<DBIx::Custom::Query> object instead of executing SQL.
1926
This is true or false value.
1927

            
1928
    my $query = $dbi->delete(query => 1);
1929

            
1930
You can check SQL.
1931

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1934
=back
1935

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

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

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

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

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

            
1947
    $dbi->delete_at(
1948
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1949
        primary_key => 'id',
1950
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1951
    );
1952

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1957
=over 4
1958

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1961
Primary key. This is constant value or array reference.
1962
    
1963
    # Constant value
1964
    $dbi->delete(primary_key => 'id');
1965

            
1966
    # Array reference
1967
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1968

            
1969
This is used to create where clause.
1970

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

            
1973
Where clause, created from primary key information.
1974
This is constant value or array reference.
1975

            
1976
    # Constant value
1977
    $dbi->delete(where => 5);
1978

            
1979
    # Array reference
1980
    $dbi->delete(where => [3, 5]);
1981

            
1982
In first examle, the following SQL is created.
1983

            
1984
    delete from book where id = ?;
1985

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1988
=back
1989

            
cleanup
yuki-kimoto authored on 2010-10-17
1990
=head2 C<insert>
1991

            
update pod
Yuki Kimoto authored on 2011-03-13
1992
    $dbi->insert(
1993
        table  => 'book', 
1994
        param  => {title => 'Perl', author => 'Ken'}
1995
    );
1996

            
1997
Insert statement.
1998

            
1999
The following opitons are currently available.
2000

            
update pod
Yuki Kimoto authored on 2011-03-13
2001
=over 4
2002

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

            
2005
Table name.
2006

            
2007
    $dbi->insert(table => 'book');
2008

            
2009
=item C<param>
2010

            
2011
Insert data. This is hash reference.
2012

            
2013
    $dbi->insert(param => {title => 'Perl'});
2014

            
2015
=item C<append>
2016

            
2017
Append statement to last of SQL. This is string.
2018

            
2019
    $dbi->insert(append => 'order by title');
2020

            
2021
=item C<filter>
2022

            
2023
Filter, executed before data is send to database. This is array reference.
2024
Filter value is code reference or
2025
filter name registerd by C<register_filter()>.
2026

            
2027
    # Basic
2028
    $dbi->insert(
2029
        filter => [
2030
            title  => sub { uc $_[0] }
2031
            author => sub { uc $_[0] }
2032
        ]
2033
    );
2034
    
2035
    # At once
2036
    $dbi->insert(
2037
        filter => [
2038
            [qw/title author/]  => sub { uc $_[0] }
2039
        ]
2040
    );
2041
    
2042
    # Filter name
2043
    $dbi->insert(
2044
        filter => [
2045
            title  => 'upper_case',
2046
            author => 'upper_case'
2047
        ]
2048
    );
2049

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

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

            
2054
Get L<DBIx::Custom::Query> object instead of executing SQL.
2055
This is true or false value.
2056

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2063
=back
2064

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

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

            
2069
    $dbi->insert_at(
2070
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2071
        primary_key => 'id',
2072
        where => '5',
2073
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2074
    );
2075

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

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

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

            
2084
Primary key. This is constant value or array reference.
2085
    
2086
    # Constant value
2087
    $dbi->insert(primary_key => 'id');
2088

            
2089
    # Array reference
2090
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2091

            
2092
This is used to create parts of insert data.
2093

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

            
2096
Parts of Insert data, create from primary key information.
2097
This is constant value or array reference.
2098

            
2099
    # Constant value
2100
    $dbi->insert(where => 5);
2101

            
2102
    # Array reference
2103
    $dbi->insert(where => [3, 5]);
2104

            
2105
In first examle, the following SQL is created.
2106

            
2107
    insert into book (id, title) values (?, ?);
2108

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2111
=back
2112

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

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

            
2117
Create insert parameter tag.
2118

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2121
=head2 C<include_model> EXPERIMENTAL
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2122

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2128
    lib / MyModel.pm
2129
        / MyModel / book.pm
2130
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2131

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

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

            
2136
    package MyModel;
2137
    
2138
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2139
    
2140
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2141

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2146
    package MyModel::book;
2147
    
2148
    use base 'MyModel';
2149
    
2150
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2151

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2154
    package MyModel::company;
2155
    
2156
    use base 'MyModel';
2157
    
2158
    1;
2159
    
2160
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2161

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

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

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2169
=head2 C<merge_param> EXPERIMENTAL
2170

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

            
2173
Merge paramters.
2174

            
2175
$param:
2176

            
2177
    {key1 => [1, 1], key2 => 2}
2178

            
update pod
Yuki Kimoto authored on 2011-03-13
2179
=head2 C<method> EXPERIMENTAL
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2180

            
2181
    $dbi->method(
2182
        update_or_insert => sub {
2183
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2184
            
2185
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2186
        },
2187
        find_or_create   => sub {
2188
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2189
            
2190
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2191
        }
2192
    );
2193

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

            
2196
    $dbi->update_or_insert;
2197
    $dbi->find_or_create;
2198

            
update pod
Yuki Kimoto authored on 2011-03-13
2199
=head2 C<model> EXPERIMENTAL
2200

            
2201
    $dbi->model('book')->method(
2202
        insert => sub { ... },
2203
        update => sub { ... }
2204
    );
2205
    
2206
    my $model = $dbi->model('book');
2207

            
2208
Set and get a L<DBIx::Custom::Model> object,
2209

            
cleanup
Yuki Kimoto authored on 2011-03-21
2210
=head2 C<mycolumn> EXPERIMENTAL
2211

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

            
2214
Create column clause for myself. The follwoing column clause is created.
2215

            
2216
    book.author as author,
2217
    book.title as title
2218

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2221
    my $dbi = DBIx::Custom->new(
2222
        data_source => "dbi:mysql:database=dbname",
2223
        user => 'ken',
2224
        password => '!LFKD%$&',
2225
        dbi_option => {mysql_enable_utf8 => 1}
2226
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2227

            
2228
Create a new L<DBIx::Custom> object.
2229

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

            
2232
    my $not_exists = $dbi->not_exists;
2233

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2237
=head2 C<register_filter>
2238

            
update pod
Yuki Kimoto authored on 2011-03-13
2239
    $dbi->register_filter(
2240
        # Time::Piece object to database DATE format
2241
        tp_to_date => sub {
2242
            my $tp = shift;
2243
            return $tp->strftime('%Y-%m-%d');
2244
        },
2245
        # database DATE format to Time::Piece object
2246
        date_to_tp => sub {
2247
           my $date = shift;
2248
           return Time::Piece->strptime($date, '%Y-%m-%d');
2249
        }
2250
    );
cleanup
yuki-kimoto authored on 2010-10-17
2251
    
update pod
Yuki Kimoto authored on 2011-03-13
2252
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2253

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2256
    $dbi->register_tag(
2257
        update => sub {
2258
            my @columns = @_;
2259
            
2260
            # Update parameters
2261
            my $s = 'set ';
2262
            $s .= "$_ = ?, " for @columns;
2263
            $s =~ s/, $//;
2264
            
2265
            return [$s, \@columns];
2266
        }
2267
    );
cleanup
yuki-kimoto authored on 2010-10-17
2268

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2290
=head2 C<replace> EXPERIMENTAL
2291
    
2292
    my $join = [
2293
        'left outer join table2 on table1.key1 = table2.key1',
2294
        'left outer join table3 on table2.key3 = table3.key3'
2295
    ];
2296
    $join = $dbi->replace(
2297
        $join,
2298
        'left outer join table2 on table1.key1 = table2.key1',
2299
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2300
          'as table2 on table1.key1 = table2.key1'
2301
    );
2302

            
2303
Replace join clauses if match the expression.
2304

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2307
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2308
        table  => 'book',
2309
        column => ['author', 'title'],
2310
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2311
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2312
    
update pod
Yuki Kimoto authored on 2011-03-12
2313
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2314

            
2315
The following opitons are currently available.
2316

            
2317
=over 4
2318

            
2319
=item C<table>
2320

            
2321
Table name.
2322

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

            
2325
=item C<column>
2326

            
2327
Column clause. This is array reference or constant value.
2328

            
2329
    # Hash refernce
2330
    $dbi->select(column => ['author', 'title']);
2331
    
2332
    # Constant value
2333
    $dbi->select(column => 'author');
2334

            
2335
Default is '*' unless C<column> is specified.
2336

            
2337
    # Default
2338
    $dbi->select(column => '*');
2339

            
2340
=item C<where>
2341

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2342
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2343
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2344
    
2345
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2346
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2347
    
update pod
Yuki Kimoto authored on 2011-03-12
2348
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2349
    my $where = $dbi->where(
2350
        clause => ['and', '{= author}', '{like title}'],
2351
        param  => {author => 'Ken', title => '%Perl%'}
2352
    );
update pod
Yuki Kimoto authored on 2011-03-12
2353
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2354

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2355
    # Array refrendce (where clause and parameter)
2356
    $dbi->select(where =>
2357
        [
2358
            ['and', '{= author}', '{like title}'],
2359
            {author => 'Ken', title => '%Perl%'}
2360
        ]
2361
    );
2362
    
update pod
Yuki Kimoto authored on 2011-03-13
2363
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2364

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

            
2367
    $dbi->select(join =>
2368
        [
2369
            'left outer join company on book.company_id = company_id',
2370
            'left outer join location on company.location_id = location.id'
2371
        ]
2372
    );
2373

            
2374
If column cluase or where clause contain table name like "company.name",
2375
needed join clause is used automatically.
2376

            
2377
    $dbi->select(
2378
        table => 'book',
2379
        column => ['company.location_id as company__location_id'],
2380
        where => {'company.name' => 'Orange'},
2381
        join => [
2382
            'left outer join company on book.company_id = company.id',
2383
            'left outer join location on company.location_id = location.id'
2384
        ]
2385
    );
2386

            
2387
In above select, the following SQL is created.
2388

            
2389
    select company.location_id as company__location_id
2390
    from book
2391
      left outer join company on book.company_id = company.id
2392
    where company.name = Orange
2393

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

            
2396
Parameter shown before where clause.
2397
    
2398
    $dbi->select(
2399
        table => 'table1',
2400
        column => 'table1.key1 as table1_key1, key2, key3',
2401
        where   => {'table1.key2' => 3},
2402
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2403
                  ' as table2 on table1.key1 = table2.key1'],
2404
        param => {'table2.key3' => 5}
2405
    );
2406

            
2407
For example, if you want to contain tag in join clause, 
2408
you can pass parameter by C<param> option.
2409

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

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

            
2414
    $dbi->select(append => 'order by title');
2415

            
2416
=item C<filter>
2417

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

            
2422
    # Basic
2423
    $dbi->select(
2424
        filter => [
2425
            title  => sub { uc $_[0] }
2426
            author => sub { uc $_[0] }
2427
        ]
2428
    );
2429
    
2430
    # At once
2431
    $dbi->select(
2432
        filter => [
2433
            [qw/title author/]  => sub { uc $_[0] }
2434
        ]
2435
    );
2436
    
2437
    # Filter name
2438
    $dbi->select(
2439
        filter => [
2440
            title  => 'upper_case',
2441
            author => 'upper_case'
2442
        ]
2443
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2444

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

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

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

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

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

            
2456
    my $sql = $query->sql;
2457

            
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
2458
=item C<type> EXPERIMENTAL
2459

            
2460
Specify database data type.
2461

            
2462
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2463
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2464

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

            
2467
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2468

            
update pod
Yuki Kimoto authored on 2011-03-12
2469
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2470

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

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

            
2475
    $dbi->select_at(
2476
        table => 'book',
2477
        primary_key => 'id',
2478
        where => '5'
2479
    );
2480

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2485
=over 4
2486

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2489
Primary key. This is constant value or array reference.
2490
    
2491
    # Constant value
2492
    $dbi->select(primary_key => 'id');
2493

            
2494
    # Array reference
2495
    $dbi->select(primary_key => ['id1', 'id2' ]);
2496

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

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

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

            
2504
    # Constant value
2505
    $dbi->select(where => 5);
2506

            
2507
    # Array reference
2508
    $dbi->select(where => [3, 5]);
2509

            
2510
In first examle, the following SQL is created.
2511

            
2512
    select * from book where id = ?
2513

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2516
=back
2517

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2520
    $dbi->update(
2521
        table  => 'book',
2522
        param  => {title => 'Perl'},
2523
        where  => {id => 4}
2524
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2525

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2530
=over 4
2531

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2534
Table name.
2535

            
2536
    $dbi->update(table => 'book');
2537

            
2538
=item C<param>
2539

            
2540
Update data. This is hash reference.
2541

            
2542
    $dbi->update(param => {title => 'Perl'});
2543

            
2544
=item C<where>
2545

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2546
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2547
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2548
    
2549
    # Hash reference
2550
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2551
    
2552
    # DBIx::Custom::Where object
2553
    my $where = $dbi->where(
2554
        clause => ['and', '{= author}', '{like title}'],
2555
        param  => {author => 'Ken', title => '%Perl%'}
2556
    );
2557
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2558
    
2559
    # Array refrendce (where clause and parameter)
2560
    $dbi->update(where =>
2561
        [
2562
            ['and', '{= author}', '{like title}'],
2563
            {author => 'Ken', title => '%Perl%'}
2564
        ]
2565
    );
update pod
Yuki Kimoto authored on 2011-03-13
2566

            
2567
=item C<append>
2568

            
2569
Append statement to last of SQL. This is string.
2570

            
2571
    $dbi->update(append => 'order by title');
2572

            
2573
=item C<filter>
2574

            
2575
Filter, executed before data is send to database. This is array reference.
2576
Filter value is code reference or
2577
filter name registerd by C<register_filter()>.
2578

            
2579
    # Basic
2580
    $dbi->update(
2581
        filter => [
2582
            title  => sub { uc $_[0] }
2583
            author => sub { uc $_[0] }
2584
        ]
2585
    );
2586
    
2587
    # At once
2588
    $dbi->update(
2589
        filter => [
2590
            [qw/title author/]  => sub { uc $_[0] }
2591
        ]
2592
    );
2593
    
2594
    # Filter name
2595
    $dbi->update(
2596
        filter => [
2597
            title  => 'upper_case',
2598
            author => 'upper_case'
2599
        ]
2600
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2601

            
update pod
Yuki Kimoto authored on 2011-03-13
2602
These filters are added to the C<out> filters, set by C<apply_filter()>.
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2603

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

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

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

            
2611
You can check SQL.
2612

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2615
=back
2616

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

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

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

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

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

            
2628
    $dbi->update_at(
2629
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2630
        primary_key => 'id',
2631
        where => '5',
2632
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2633
    );
2634

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2639
=over 4
2640

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

            
2643
Primary key. This is constant value or array reference.
2644
    
2645
    # Constant value
2646
    $dbi->update(primary_key => 'id');
2647

            
2648
    # Array reference
2649
    $dbi->update(primary_key => ['id1', 'id2' ]);
2650

            
2651
This is used to create where clause.
2652

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

            
2655
Where clause, created from primary key information.
2656
This is constant value or array reference.
2657

            
2658
    # Constant value
2659
    $dbi->update(where => 5);
2660

            
2661
    # Array reference
2662
    $dbi->update(where => [3, 5]);
2663

            
2664
In first examle, the following SQL is created.
2665

            
2666
    update book set title = ? where id = ?
2667

            
2668
Place holders are set to 'Perl' and 5.
2669

            
update pod
Yuki Kimoto authored on 2011-03-13
2670
=back
2671

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

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

            
2676
Create update parameter tag.
2677

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2680
You can create tag without 'set '
2681
by C<no_set> option. This option is EXPERIMENTAL.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2682

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2683
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2684
        {title => 'a', age => 2}
2685
        {no_set => 1}
2686
    );
2687

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2692
    my $where = $dbi->where(
2693
        clause => ['and', '{= title}', '{= author}'],
2694
        param => {title => 'Perl', author => 'Ken'}
2695
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2696

            
2697
Create a new L<DBIx::Custom::Where> object.
2698

            
update pod
Yuki Kimoto authored on 2011-03-13
2699
=head2 C<setup_model> EXPERIMENTAL
cleanup
Yuki Kimoto authored on 2011-01-12
2700

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2706
=head1 Tags
2707

            
2708
The following tags is available.
2709

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2710
=head2 C<table>
add table tag
Yuki Kimoto authored on 2011-02-09
2711

            
2712
Table tag
2713

            
2714
    {table TABLE}    ->    TABLE
2715

            
update pod
Yuki Kimoto authored on 2011-03-13
2716
This is used to tell C<execute()> what table is needed .
add table tag
Yuki Kimoto authored on 2011-02-09
2717

            
cleanup
Yuki Kimoto authored on 2011-01-25
2718
=head2 C<?>
2719

            
2720
Placeholder tag.
2721

            
2722
    {? NAME}    ->   ?
2723

            
2724
=head2 C<=>
2725

            
2726
Equal tag.
2727

            
2728
    {= NAME}    ->   NAME = ?
2729

            
2730
=head2 C<E<lt>E<gt>>
2731

            
2732
Not equal tag.
2733

            
2734
    {<> NAME}   ->   NAME <> ?
2735

            
2736
=head2 C<E<lt>>
2737

            
2738
Lower than tag
2739

            
2740
    {< NAME}    ->   NAME < ?
2741

            
2742
=head2 C<E<gt>>
2743

            
2744
Greater than tag
2745

            
2746
    {> NAME}    ->   NAME > ?
2747

            
2748
=head2 C<E<gt>=>
2749

            
2750
Greater than or equal tag
2751

            
2752
    {>= NAME}   ->   NAME >= ?
2753

            
2754
=head2 C<E<lt>=>
2755

            
2756
Lower than or equal tag
2757

            
2758
    {<= NAME}   ->   NAME <= ?
2759

            
2760
=head2 C<like>
2761

            
2762
Like tag
2763

            
2764
    {like NAME}   ->   NAME like ?
2765

            
2766
=head2 C<in>
2767

            
2768
In tag.
2769

            
2770
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2771

            
2772
=head2 C<insert_param>
2773

            
2774
Insert parameter tag.
2775

            
2776
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2777

            
2778
=head2 C<update_param>
2779

            
2780
Updata parameter tag.
2781

            
2782
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2783

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

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

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

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

            
2793
C<< <kimoto.yuki at gmail.com> >>
2794

            
2795
L<http://github.com/yuki-kimoto/DBIx-Custom>
2796

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2797
=head1 AUTHOR
2798

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

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

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

            
2805
This program is free software; you can redistribute it and/or modify it
2806
under the same terms as Perl itself.
2807

            
2808
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2809

            
2810