DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2845 lines | 68.408kb
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
    
update pod
Yuki Kimoto authored on 2011-03-13
624
    # Insert parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
625
    my @names;
626
    my @placeholders;
627
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
628
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
629
    my $q = $self->reserved_word_quote;
630
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
631
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
632
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
633
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
634
        
635
        my $c = "$q$column$q";
636
        $c =~ s/\./$q.$q/;
637
        
638
        push @names, $c;
639
        push @placeholders, "{? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
640
    }
641
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
642
    return '(' . join(', ', @names) . ') ' . 'values' .
643
           ' (' . join(', ', @placeholders) . ')';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
644
}
645

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
646
sub include_model {
647
    my ($self, $name_space, $model_infos) = @_;
648
    
649
    $name_space ||= '';
650
    unless ($model_infos) {
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
        
668
        close $dh;
669
    }
670
    
671
    foreach my $model_info (@$model_infos) {
672
        
673
        # Model class, name, table
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
        
688
        # Load
689
        croak qq{"$mclass" is invalid class name}
690
          if $mclass =~ /[^\w:]/;
691
        unless ($mclass->can('isa')) {
692
            eval "use $mclass";
693
            croak $@ if $@;
694
        }
695
        
696
        # Instantiate
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
697
        my $args = {};
698
        $args->{model_class} = $mclass if $mclass;
699
        $args->{name}        = $model_name if $model_name;
700
        $args->{table}       = $model_table if $model_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
701
        
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
702
        # Create model
703
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
704
    }
705
    
706
    return $self;
707
}
708

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
730
sub method {
731
    my $self = shift;
732
    
733
    # Merge
734
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
735
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
736
    
737
    return $self;
738
}
739

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

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

            
added dbi_options attribute
kimoto authored on 2010-12-20
769
sub new {
770
    my $self = shift->SUPER::new(@_);
771
    
772
    # Check attribute names
773
    my @attrs = keys %$self;
774
    foreach my $attr (@attrs) {
775
        croak qq{"$attr" is invalid attribute name}
776
          unless $self->can($attr);
777
    }
cleanup
Yuki Kimoto authored on 2011-01-25
778

            
779
    $self->register_tag(
780
        '?'     => \&DBIx::Custom::Tag::placeholder,
781
        '='     => \&DBIx::Custom::Tag::equal,
782
        '<>'    => \&DBIx::Custom::Tag::not_equal,
783
        '>'     => \&DBIx::Custom::Tag::greater_than,
784
        '<'     => \&DBIx::Custom::Tag::lower_than,
785
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
786
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
787
        'like'  => \&DBIx::Custom::Tag::like,
788
        'in'    => \&DBIx::Custom::Tag::in,
789
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
790
        'update_param' => \&DBIx::Custom::Tag::update_param
791
    );
added dbi_options attribute
kimoto authored on 2010-12-20
792
    
793
    return $self;
794
}
795

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
835
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
836
    my $q = $self->reserved_word_quote;
packaging one directory
yuki-kimoto authored on 2009-11-16
837
    
cleanup
Yuki Kimoto authored on 2011-03-09
838
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
839
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
840
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
841
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
842
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
843
    
refactoring select
yuki-kimoto authored on 2010-04-28
844
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
845
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
846
    my $tables = ref $table eq 'ARRAY' ? $table
847
               : defined $table ? [$table]
848
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
849
    my $columns   = delete $args{column};
850
    my $where     = delete $args{where} || {};
851
    my $append    = delete $args{append};
852
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
853
    croak qq{"join" must be array reference}
854
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
855
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
856
    my $param = delete $args{param} || {};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
857
    
cleanup
Yuki Kimoto authored on 2011-03-09
858
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
859
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
860
    
cleanup
Yuki Kimoto authored on 2011-01-27
861
    # SQL stack
862
    my @sql;
863
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
864
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
865
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
866
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
867
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
868
        foreach my $column (@$columns) {
869
            unshift @$tables, @{$self->_tables($column)};
870
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
871
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
872
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
873
    }
874
    
875
    # "*" is default
876
    else { push @sql, '*' }
877
    
878
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
879
    push @sql, 'from';
880
    if ($relation) {
881
        my $found = {};
882
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
883
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
884
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
885
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
886
    }
cleanup
Yuki Kimoto authored on 2011-03-30
887
    else {
888
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
889
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
890
    }
891
    pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
892
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
893
    # Main table
894
    croak "Not found table name" unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
895

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

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

            
942
sub select_at {
943
    my ($self, %args) = @_;
944
    
cleanup
Yuki Kimoto authored on 2011-03-09
945
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
946
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
947
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
948
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
949
    }
950
    
951
    # Primary key
952
    my $primary_keys = delete $args{primary_key};
953
    $primary_keys = [$primary_keys] unless ref $primary_keys;
954
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
955
    # Table
956
    croak qq{"table" option must be specified} unless $args{table};
957
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
958
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
959
    # Where clause
960
    my $where = {};
961
    if (exists $args{where}) {
962
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
963
        
964
        croak qq{"where" must be constant value or array reference}
965
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
966
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
967
        $where_columns = [$where_columns] unless ref $where_columns;
968
        
969
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
970
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
971
        }
972
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
973
    
974
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
975
        my $param = delete $args{param};
976
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
977
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
978
        }
979
    }
980
    
981
    return $self->select(where => $where, %args);
982
}
983

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
984
sub setup_model {
985
    my $self = shift;
986
    
987
    $self->each_column(
988
        sub {
989
            my ($self, $table, $column, $column_info) = @_;
990
            
991
            if (my $model = $self->models->{$table}) {
992
                push @{$model->columns}, $column;
993
            }
994
        }
995
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
996
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
997
}
998

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1005
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1006
    my $q = $self->reserved_word_quote;
version 0.0901
yuki-kimoto authored on 2009-12-17
1007
    
cleanup
Yuki Kimoto authored on 2011-03-09
1008
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1009
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1010
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1011
          unless $UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1012
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1013
    
cleanup
yuki-kimoto authored on 2010-10-17
1014
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1015
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1016
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1017
    my $param            = delete $args{param} || {};
1018
    my $where            = delete $args{where} || {};
1019
    my $append           = delete $args{append} || '';
1020
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1021
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1022
    # Columns
1023
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1024
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1025
    foreach my $column (keys %$param) {
1026
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1027
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1028
          $column = "$q$column$q";
1029
          $column =~ s/\./$q.$q/;
1030
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1031
    }
1032
        
cleanup
yuki-kimoto authored on 2010-10-17
1033
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1034
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1035

            
1036
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
1037
    my $w = $self->_where_to_obj($where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1038
    $where = $w->param;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1039
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1040
    # String where
1041
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1042
    
1043
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1044
      if "$swhere" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1045
    
cleanup
Yuki Kimoto authored on 2011-01-27
1046
    # SQL stack
1047
    my @sql;
1048
    
1049
    # Update
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1050
    push @sql, "update $q$table$q $update_clause $swhere";
cleanup
Yuki Kimoto authored on 2011-01-27
1051
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1052
    
cleanup
yuki-kimoto authored on 2010-10-17
1053
    # Rearrange parameters
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1054
    foreach my $wkey (keys %$where) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1055
        
cleanup
yuki-kimoto authored on 2010-10-17
1056
        if (exists $param->{$wkey}) {
1057
            $param->{$wkey} = [$param->{$wkey}]
1058
              unless ref $param->{$wkey} eq 'ARRAY';
1059
            
1060
            push @{$param->{$wkey}}, $where->{$wkey};
1061
        }
1062
        else {
1063
            $param->{$wkey} = $where->{$wkey};
1064
        }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1065
    }
cleanup
yuki-kimoto authored on 2010-10-17
1066
    
cleanup
Yuki Kimoto authored on 2011-01-27
1067
    # SQL
1068
    my $sql = join(' ', @sql);
1069
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1070
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1071
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1072
    return $query if $args{query};
1073
    
cleanup
yuki-kimoto authored on 2010-10-17
1074
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1075
    my $ret_val = $self->execute(
1076
        $query,
1077
        param  => $param, 
1078
        table => $table,
1079
        %args
1080
    );
cleanup
yuki-kimoto authored on 2010-10-17
1081
    
1082
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1083
}
1084

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

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

            
1089
sub update_at {
1090
    my ($self, %args) = @_;
1091
    
cleanup
Yuki Kimoto authored on 2011-03-09
1092
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1093
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1094
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1095
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1096
    }
1097
    
1098
    # Primary key
1099
    my $primary_keys = delete $args{primary_key};
1100
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1101
    
1102
    # Where clause
1103
    my $where = {};
1104
    my $param = {};
1105
    
1106
    if (exists $args{where}) {
1107
        my $where_columns = delete $args{where};
1108
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1109

            
1110
        croak qq{"where" must be constant value or array reference}
1111
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1112
        
1113
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1114
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1115
        }
1116
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1117
    
1118
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1119
        $param = delete $args{param};
1120
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1121
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1122
        }
1123
    }
1124
    
1125
    return $self->update(where => $where, param => $param, %args);
1126
}
1127

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1128
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1129
    my ($self, $param, $opt) = @_;
1130
    
1131
    # Insert parameter tag
1132
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1133
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1134
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1135
    my $q = $self->reserved_word_quote;
1136
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1137
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1138
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1139
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1140
        
1141
        my $c = "$q$column$q";
1142
        $c =~ s/\./$q.$q/;
1143
        
1144
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1145
    }
1146
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1147
    my $clause;
1148
    $clause .= 'set ' unless $opt->{no_set};
1149
    $clause .= join(', ', @params);
1150
    
1151
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1152
}
1153

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

            
1157
    return DBIx::Custom::Where->new(
1158
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1159
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1160
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1161
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1162
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1163
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1164

            
cleanup
Yuki Kimoto authored on 2011-04-02
1165
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1166
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1167
    
cleanup
Yuki Kimoto authored on 2011-01-12
1168
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1169
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1170
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1171
    # Build bind values
1172
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1173
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1174
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1175
        
1176
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1177
        my $value;
1178
        if(ref $params->{$column} eq 'ARRAY') {
1179
            my $i = $count->{$column} || 0;
1180
            $i += $not_exists->{$column} || 0;
1181
            my $found;
1182
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1183
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1184
                    $not_exists->{$column}++;
1185
                }
1186
                else  {
1187
                    $value = $params->{$column}->[$k];
1188
                    $found = 1;
1189
                    last
1190
                }
1191
            }
1192
            next unless $found;
1193
        }
1194
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1195
        
cleanup
Yuki Kimoto authored on 2011-01-12
1196
        # Filter
1197
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1198
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1199
        # Type
1200
        push @$bind, {
1201
            value => $f ? $f->($value) : $value,
1202
            type => $type->{$column}
1203
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1204
        
1205
        # Count up 
1206
        $count->{$column}++;
1207
    }
1208
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1209
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1210
}
1211

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1259
sub _need_tables {
1260
    my ($self, $tree, $need_tables, $tables) = @_;
1261
    
1262
    foreach my $table (@$tables) {
1263
        
1264
        if ($tree->{$table}) {
1265
            $need_tables->{$table} = 1;
1266
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1267
        }
1268
    }
1269
}
1270

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

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1307
    foreach my $need_table (@need_tables) {
1308
        push @$sql, $tree->{$need_table}{join};
1309
    }
1310
}
cleanup
Yuki Kimoto authored on 2011-03-08
1311

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

            
1322
sub _tables {
1323
    my ($self, $source) = @_;
1324
    
1325
    my $tables = [];
1326
    
1327
    my $safety_character = $self->safety_character;
1328
    my $q = $self->reserved_word_quote;
1329
    my $q_re = quotemeta($q);
1330
    
1331
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1332
                      : qr/\b([$safety_character]+)\./;
1333
    while ($source =~ /$table_re/g) {
1334
        push @$tables, $1;
1335
    }
1336
    
1337
    return $tables;
1338
}
1339

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1375
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1376
__PACKAGE__->attr(
1377
    dbi_options => sub { {} },
1378
    filter_check  => 1
1379
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1380

            
cleanup
Yuki Kimoto authored on 2011-01-25
1381
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1382
sub default_bind_filter {
1383
    my $self = shift;
1384
    
1385
    if (@_) {
1386
        my $fname = $_[0];
1387
        
1388
        if (@_ && !$fname) {
1389
            $self->{default_out_filter} = undef;
1390
        }
1391
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1392
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1393
              unless exists $self->filters->{$fname};
1394
        
1395
            $self->{default_out_filter} = $self->filters->{$fname};
1396
        }
1397
        return $self;
1398
    }
1399
    
1400
    return $self->{default_out_filter};
1401
}
1402

            
cleanup
Yuki Kimoto authored on 2011-01-25
1403
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1404
sub default_fetch_filter {
1405
    my $self = shift;
1406
    
1407
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1408
        my $fname = $_[0];
1409

            
cleanup
Yuki Kimoto authored on 2011-01-12
1410
        if (@_ && !$fname) {
1411
            $self->{default_in_filter} = undef;
1412
        }
1413
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1414
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1415
              unless exists $self->filters->{$fname};
1416
        
1417
            $self->{default_in_filter} = $self->filters->{$fname};
1418
        }
1419
        
1420
        return $self;
1421
    }
1422
    
many changed
Yuki Kimoto authored on 2011-01-23
1423
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1424
}
1425

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1426
# DEPRECATED!
1427
sub insert_param {
1428
    warn "insert_param is renamed to insert_param_tag."
1429
       . " insert_param is DEPRECATED!";
1430
    return shift->insert_param_tag(@_);
1431
}
1432

            
cleanup
Yuki Kimoto authored on 2011-01-25
1433
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1434
sub register_tag_processor {
1435
    return shift->query_builder->register_tag_processor(@_);
1436
}
1437

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1438
# DEPRECATED!
1439
sub update_param {
1440
    warn "update_param is renamed to update_param_tag."
1441
       . " update_param is DEPRECATED!";
1442
    return shift->update_param_tag(@_);
1443
}
cleanup
Yuki Kimoto authored on 2011-03-08
1444
# DEPRECATED!
1445
sub _push_relation {
1446
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1447
    
1448
    if (keys %{$relation || {}}) {
1449
        push @$sql, $need_where ? 'where' : 'and';
1450
        foreach my $rcolumn (keys %$relation) {
1451
            my $table1 = (split (/\./, $rcolumn))[0];
1452
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1453
            push @$tables, ($table1, $table2);
1454
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1455
        }
1456
    }
1457
    pop @$sql if $sql->[-1] eq 'and';    
1458
}
1459

            
1460
# DEPRECATED!
1461
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1462
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1463
    
1464
    if (keys %{$relation || {}}) {
1465
        foreach my $rcolumn (keys %$relation) {
1466
            my $table1 = (split (/\./, $rcolumn))[0];
1467
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1468
            my $table1_exists;
1469
            my $table2_exists;
1470
            foreach my $table (@$tables) {
1471
                $table1_exists = 1 if $table eq $table1;
1472
                $table2_exists = 1 if $table eq $table2;
1473
            }
1474
            unshift @$tables, $table1 unless $table1_exists;
1475
            unshift @$tables, $table2 unless $table2_exists;
1476
        }
1477
    }
1478
}
1479

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1482
=head1 NAME
1483

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

            
1486
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1487

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1488
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1489
    
1490
    # Connect
1491
    my $dbi = DBIx::Custom->connect(
1492
        data_source => "dbi:mysql:database=dbname",
1493
        user => 'ken',
1494
        password => '!LFKD%$&',
1495
        dbi_option => {mysql_enable_utf8 => 1}
1496
    );
cleanup
yuki-kimoto authored on 2010-08-05
1497

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1498
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1499
    $dbi->insert(
1500
        table  => 'book',
1501
        param  => {title => 'Perl', author => 'Ken'}
1502
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1503
    
1504
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1505
    $dbi->update(
1506
        table  => 'book', 
1507
        param  => {title => 'Perl', author => 'Ken'}, 
1508
        where  => {id => 5},
1509
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1510
    
1511
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1512
    $dbi->delete(
1513
        table  => 'book',
1514
        where  => {author => 'Ken'},
1515
    );
cleanup
yuki-kimoto authored on 2010-08-05
1516

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1523
    # Select, more complex
1524
    my $result = $dbi->select(
1525
        table  => 'book',
1526
        column => [
1527
            'book.author as book__author',
1528
            'company.name as company__name'
1529
        ],
1530
        where  => {'book.author' => 'Ken'},
1531
        join => ['left outer join company on book.company_id = company.id'],
1532
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1533
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1534
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1535
    # Fetch
1536
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1537
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1538
    }
1539
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1540
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1541
    while (my $row = $result->fetch_hash) {
1542
        
1543
    }
1544
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1545
    # Execute SQL with parameter.
1546
    $dbi->execute(
1547
        "select id from book where {= author} and {like title}",
1548
        param  => {author => 'ken', title => '%Perl%'}
1549
    );
1550
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1551
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1552

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

            
1555
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1556

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1561
There are many basic methods to execute various queries.
1562
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1563
C<delete_all()>, C<select()>,
1564
C<insert_at()>, C<update_at()>, 
1565
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1566

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1567
=item *
1568

            
1569
Filter when data is send or receive.
1570

            
1571
=item *
1572

            
1573
Data filtering system
1574

            
1575
=item *
1576

            
1577
Model support.
1578

            
1579
=item *
1580

            
1581
Generate where clause dinamically.
1582

            
1583
=item *
1584

            
1585
Generate join clause dinamically.
1586

            
1587
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1588

            
1589
=head1 GUIDE
1590

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

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

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

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

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

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

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

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

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

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

            
1614
=head2 C<default_dbi_option>
1615

            
1616
    my $default_dbi_option = $dbi->default_dbi_option;
1617
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1618

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1622
    {
1623
        RaiseError => 1,
1624
        PrintError => 0,
1625
        AutoCommit => 1,
1626
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1627

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

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

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

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

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

            
1640
    my $models = $dbi->models;
1641
    $dbi       = $dbi->models(\%models);
1642

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1645
=head2 C<password>
1646

            
1647
    my $password = $dbi->password;
1648
    $dbi         = $dbi->password('lkj&le`@s');
1649

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

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

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

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

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

            
1661
     my reserved_word_quote = $dbi->reserved_word_quote;
1662
     $dbi                   = $dbi->reserved_word_quote('"');
1663

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1683
    my $user = $dbi->user;
1684
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1685

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1696
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1697
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1698
        'issue_date' => {
1699
            out => 'tp_to_date',
1700
            in  => 'date_to_tp',
1701
            end => 'tp_to_displaydate'
1702
        },
1703
        'write_date' => {
1704
            out => 'tp_to_date',
1705
            in  => 'date_to_tp',
1706
            end => 'tp_to_displaydate'
1707
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1708
    );
1709

            
update pod
Yuki Kimoto authored on 2011-03-13
1710
Apply filter to columns.
1711
C<out> filter is executed before data is send to database.
1712
C<in> filter is executed after a row is fetch.
1713
C<end> filter is execute after C<in> filter is executed.
1714

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1717
       PETTERN         EXAMPLE
1718
    1. Column        : author
1719
    2. Table.Column  : book.author
1720
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1721

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

            
1725
You can set multiple filters at once.
1726

            
1727
    $dbi->apply_filter(
1728
        'book',
1729
        [qw/issue_date write_date/] => {
1730
            out => 'tp_to_date',
1731
            in  => 'date_to_tp',
1732
            end => 'tp_to_displaydate'
1733
        }
1734
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1735

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1738
    my $dbi = DBIx::Custom->connect(
1739
        data_source => "dbi:mysql:database=dbname",
1740
        user => 'ken',
1741
        password => '!LFKD%$&',
1742
        dbi_option => {mysql_enable_utf8 => 1}
1743
    );
1744

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1753
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1754
        table => 'book',
1755
        primary_key => 'id',
1756
        join => [
1757
            'inner join company on book.comparny_id = company.id'
1758
        ],
1759
        filter => [
1760
            publish_date => {
1761
                out => 'tp_to_date',
1762
                in => 'date_to_tp',
1763
                end => 'tp_to_displaydate'
1764
            }
1765
        ]
1766
    );
1767

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

            
1771
   $dbi->model('book')->select(...);
1772

            
cleanup
yuki-kimoto authored on 2010-10-17
1773
=head2 C<create_query>
1774
    
1775
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1776
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1777
    );
update document
yuki-kimoto authored on 2009-11-19
1778

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

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

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

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

            
1789
    my $dbh = $dbi->dbh;
1790
    $dbi    = $dbi->dbh($dbh);
1791

            
1792
Get and set database handle of L<DBI>.
1793

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

            
1796
=head2 C<each_column>
1797

            
1798
    $dbi->each_column(
1799
        sub {
1800
            my ($dbi, $table, $column, $column_info) = @_;
1801
            
1802
            my $type = $column_info->{TYPE_NAME};
1803
            
1804
            if ($type eq 'DATE') {
1805
                # ...
1806
            }
1807
        }
1808
    );
1809

            
1810
Iterate all column informations of all table from database.
1811
Argument is callback when one column is found.
1812
Callback receive four arguments, dbi object, table name,
1813
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1814

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1817
    my $result = $dbi->execute(
1818
        "select * from book where {= title} and {like author}",
1819
        param => {title => 'Perl', author => '%Ken%'}
1820
    );
1821

            
1822
Execute SQL, containing tags.
1823
Return value is L<DBIx::Custom::Result> in select statement, or
1824
the count of affected rows in insert, update, delete statement.
1825

            
1826
Tag is turned into the statement containing place holder
1827
before SQL is executed.
1828

            
1829
    select * from where title = ? and author like ?;
1830

            
1831
See also L<Tags/Tags>.
1832

            
1833
The following opitons are currently available.
1834

            
1835
=over 4
1836

            
1837
=item C<filter>
1838

            
1839
Filter, executed before data is send to database. This is array reference.
1840
Filter value is code reference or
1841
filter name registerd by C<register_filter()>.
1842

            
1843
    # Basic
1844
    $dbi->execute(
1845
        $sql,
1846
        filter => [
1847
            title  => sub { uc $_[0] }
1848
            author => sub { uc $_[0] }
1849
        ]
1850
    );
1851
    
1852
    # At once
1853
    $dbi->execute(
1854
        $sql,
1855
        filter => [
1856
            [qw/title author/]  => sub { uc $_[0] }
1857
        ]
1858
    );
1859
    
1860
    # Filter name
1861
    $dbi->execute(
1862
        $sql,
1863
        filter => [
1864
            title  => 'upper_case',
1865
            author => 'upper_case'
1866
        ]
1867
    );
1868

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

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

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

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

            
1877
Delete statement.
1878

            
1879
The following opitons are currently available.
1880

            
update pod
Yuki Kimoto authored on 2011-03-13
1881
=over 4
1882

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

            
1885
Table name.
1886

            
1887
    $dbi->delete(table => 'book');
1888

            
1889
=item C<where>
1890

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1891
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1892
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1893
    
1894
    # Hash reference
1895
    $dbi->delete(where => {title => 'Perl'});
1896
    
1897
    # DBIx::Custom::Where object
1898
    my $where = $dbi->where(
1899
        clause => ['and', '{= author}', '{like title}'],
1900
        param  => {author => 'Ken', title => '%Perl%'}
1901
    );
1902
    $dbi->delete(where => $where);
1903

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1904
    # Array refrendce (where clause and parameter)
1905
    $dbi->delete(where =>
1906
        [
1907
            ['and', '{= author}', '{like title}'],
1908
            {author => 'Ken', title => '%Perl%'}
1909
        ]
1910
    );
1911
    
update pod
Yuki Kimoto authored on 2011-03-13
1912
=item C<append>
1913

            
1914
Append statement to last of SQL. This is string.
1915

            
1916
    $dbi->delete(append => 'order by title');
1917

            
1918
=item C<filter>
1919

            
1920
Filter, executed before data is send to database. This is array reference.
1921
Filter value is code reference or
1922
filter name registerd by C<register_filter()>.
1923

            
1924
    # Basic
1925
    $dbi->delete(
1926
        filter => [
1927
            title  => sub { uc $_[0] }
1928
            author => sub { uc $_[0] }
1929
        ]
1930
    );
1931
    
1932
    # At once
1933
    $dbi->delete(
1934
        filter => [
1935
            [qw/title author/]  => sub { uc $_[0] }
1936
        ]
1937
    );
1938
    
1939
    # Filter name
1940
    $dbi->delete(
1941
        filter => [
1942
            title  => 'upper_case',
1943
            author => 'upper_case'
1944
        ]
1945
    );
1946

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

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

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

            
1953
Create column clause. The follwoing column clause is created.
1954

            
1955
    book.author as book__author,
1956
    book.title as book__title
1957

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

            
1960
Get L<DBIx::Custom::Query> object instead of executing SQL.
1961
This is true or false value.
1962

            
1963
    my $query = $dbi->delete(query => 1);
1964

            
1965
You can check SQL.
1966

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1969
=back
1970

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

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

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

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

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

            
1982
    $dbi->delete_at(
1983
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1984
        primary_key => 'id',
1985
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1986
    );
1987

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1992
=over 4
1993

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1996
Primary key. This is constant value or array reference.
1997
    
1998
    # Constant value
1999
    $dbi->delete(primary_key => 'id');
2000

            
2001
    # Array reference
2002
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2003

            
2004
This is used to create where clause.
2005

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

            
2008
Where clause, created from primary key information.
2009
This is constant value or array reference.
2010

            
2011
    # Constant value
2012
    $dbi->delete(where => 5);
2013

            
2014
    # Array reference
2015
    $dbi->delete(where => [3, 5]);
2016

            
2017
In first examle, the following SQL is created.
2018

            
2019
    delete from book where id = ?;
2020

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2023
=back
2024

            
cleanup
yuki-kimoto authored on 2010-10-17
2025
=head2 C<insert>
2026

            
update pod
Yuki Kimoto authored on 2011-03-13
2027
    $dbi->insert(
2028
        table  => 'book', 
2029
        param  => {title => 'Perl', author => 'Ken'}
2030
    );
2031

            
2032
Insert statement.
2033

            
2034
The following opitons are currently available.
2035

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

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

            
2040
Table name.
2041

            
2042
    $dbi->insert(table => 'book');
2043

            
2044
=item C<param>
2045

            
2046
Insert data. This is hash reference.
2047

            
2048
    $dbi->insert(param => {title => 'Perl'});
2049

            
2050
=item C<append>
2051

            
2052
Append statement to last of SQL. This is string.
2053

            
2054
    $dbi->insert(append => 'order by title');
2055

            
2056
=item C<filter>
2057

            
2058
Filter, executed before data is send to database. This is array reference.
2059
Filter value is code reference or
2060
filter name registerd by C<register_filter()>.
2061

            
2062
    # Basic
2063
    $dbi->insert(
2064
        filter => [
2065
            title  => sub { uc $_[0] }
2066
            author => sub { uc $_[0] }
2067
        ]
2068
    );
2069
    
2070
    # At once
2071
    $dbi->insert(
2072
        filter => [
2073
            [qw/title author/]  => sub { uc $_[0] }
2074
        ]
2075
    );
2076
    
2077
    # Filter name
2078
    $dbi->insert(
2079
        filter => [
2080
            title  => 'upper_case',
2081
            author => 'upper_case'
2082
        ]
2083
    );
2084

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

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

            
2089
Get L<DBIx::Custom::Query> object instead of executing SQL.
2090
This is true or false value.
2091

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2098
=back
2099

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

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

            
2104
    $dbi->insert_at(
2105
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2106
        primary_key => 'id',
2107
        where => '5',
2108
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2109
    );
2110

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2115
=over 4
2116

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

            
2119
Primary key. This is constant value or array reference.
2120
    
2121
    # Constant value
2122
    $dbi->insert(primary_key => 'id');
2123

            
2124
    # Array reference
2125
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2126

            
2127
This is used to create parts of insert data.
2128

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

            
2131
Parts of Insert data, create from primary key information.
2132
This is constant value or array reference.
2133

            
2134
    # Constant value
2135
    $dbi->insert(where => 5);
2136

            
2137
    # Array reference
2138
    $dbi->insert(where => [3, 5]);
2139

            
2140
In first examle, the following SQL is created.
2141

            
2142
    insert into book (id, title) values (?, ?);
2143

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2146
=back
2147

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

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

            
2152
Create insert parameter tag.
2153

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2163
    lib / MyModel.pm
2164
        / MyModel / book.pm
2165
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2166

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

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

            
2171
    package MyModel;
2172
    
2173
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2174
    
2175
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2176

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2181
    package MyModel::book;
2182
    
2183
    use base 'MyModel';
2184
    
2185
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2186

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2189
    package MyModel::company;
2190
    
2191
    use base 'MyModel';
2192
    
2193
    1;
2194
    
2195
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2196

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

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

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

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

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

            
2208
Merge paramters.
2209

            
2210
$param:
2211

            
2212
    {key1 => [1, 1], key2 => 2}
2213

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

            
2216
    $dbi->method(
2217
        update_or_insert => sub {
2218
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2219
            
2220
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2221
        },
2222
        find_or_create   => sub {
2223
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2224
            
2225
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2226
        }
2227
    );
2228

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

            
2231
    $dbi->update_or_insert;
2232
    $dbi->find_or_create;
2233

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

            
2236
    $dbi->model('book')->method(
2237
        insert => sub { ... },
2238
        update => sub { ... }
2239
    );
2240
    
2241
    my $model = $dbi->model('book');
2242

            
2243
Set and get a L<DBIx::Custom::Model> object,
2244

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

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

            
2249
Create column clause for myself. The follwoing column clause is created.
2250

            
2251
    book.author as author,
2252
    book.title as title
2253

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2256
    my $dbi = DBIx::Custom->new(
2257
        data_source => "dbi:mysql:database=dbname",
2258
        user => 'ken',
2259
        password => '!LFKD%$&',
2260
        dbi_option => {mysql_enable_utf8 => 1}
2261
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2262

            
2263
Create a new L<DBIx::Custom> object.
2264

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

            
2267
    my $not_exists = $dbi->not_exists;
2268

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2272
=head2 C<register_filter>
2273

            
update pod
Yuki Kimoto authored on 2011-03-13
2274
    $dbi->register_filter(
2275
        # Time::Piece object to database DATE format
2276
        tp_to_date => sub {
2277
            my $tp = shift;
2278
            return $tp->strftime('%Y-%m-%d');
2279
        },
2280
        # database DATE format to Time::Piece object
2281
        date_to_tp => sub {
2282
           my $date = shift;
2283
           return Time::Piece->strptime($date, '%Y-%m-%d');
2284
        }
2285
    );
cleanup
yuki-kimoto authored on 2010-10-17
2286
    
update pod
Yuki Kimoto authored on 2011-03-13
2287
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2288

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2291
    $dbi->register_tag(
2292
        update => sub {
2293
            my @columns = @_;
2294
            
2295
            # Update parameters
2296
            my $s = 'set ';
2297
            $s .= "$_ = ?, " for @columns;
2298
            $s =~ s/, $//;
2299
            
2300
            return [$s, \@columns];
2301
        }
2302
    );
cleanup
yuki-kimoto authored on 2010-10-17
2303

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2325
=head2 C<replace> EXPERIMENTAL
2326
    
2327
    my $join = [
2328
        'left outer join table2 on table1.key1 = table2.key1',
2329
        'left outer join table3 on table2.key3 = table3.key3'
2330
    ];
2331
    $join = $dbi->replace(
2332
        $join,
2333
        'left outer join table2 on table1.key1 = table2.key1',
2334
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2335
          'as table2 on table1.key1 = table2.key1'
2336
    );
2337

            
2338
Replace join clauses if match the expression.
2339

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2342
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2343
        table  => 'book',
2344
        column => ['author', 'title'],
2345
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2346
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2347
    
update pod
Yuki Kimoto authored on 2011-03-12
2348
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2349

            
2350
The following opitons are currently available.
2351

            
2352
=over 4
2353

            
2354
=item C<table>
2355

            
2356
Table name.
2357

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

            
2360
=item C<column>
2361

            
2362
Column clause. This is array reference or constant value.
2363

            
2364
    # Hash refernce
2365
    $dbi->select(column => ['author', 'title']);
2366
    
2367
    # Constant value
2368
    $dbi->select(column => 'author');
2369

            
2370
Default is '*' unless C<column> is specified.
2371

            
2372
    # Default
2373
    $dbi->select(column => '*');
2374

            
2375
=item C<where>
2376

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2377
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2378
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2379
    
2380
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2381
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2382
    
update pod
Yuki Kimoto authored on 2011-03-12
2383
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2384
    my $where = $dbi->where(
2385
        clause => ['and', '{= author}', '{like title}'],
2386
        param  => {author => 'Ken', title => '%Perl%'}
2387
    );
update pod
Yuki Kimoto authored on 2011-03-12
2388
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2389

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2390
    # Array refrendce (where clause and parameter)
2391
    $dbi->select(where =>
2392
        [
2393
            ['and', '{= author}', '{like title}'],
2394
            {author => 'Ken', title => '%Perl%'}
2395
        ]
2396
    );
2397
    
update pod
Yuki Kimoto authored on 2011-03-13
2398
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2399

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

            
2402
    $dbi->select(join =>
2403
        [
2404
            'left outer join company on book.company_id = company_id',
2405
            'left outer join location on company.location_id = location.id'
2406
        ]
2407
    );
2408

            
2409
If column cluase or where clause contain table name like "company.name",
2410
needed join clause is used automatically.
2411

            
2412
    $dbi->select(
2413
        table => 'book',
2414
        column => ['company.location_id as company__location_id'],
2415
        where => {'company.name' => 'Orange'},
2416
        join => [
2417
            'left outer join company on book.company_id = company.id',
2418
            'left outer join location on company.location_id = location.id'
2419
        ]
2420
    );
2421

            
2422
In above select, the following SQL is created.
2423

            
2424
    select company.location_id as company__location_id
2425
    from book
2426
      left outer join company on book.company_id = company.id
2427
    where company.name = Orange
2428

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

            
2431
Parameter shown before where clause.
2432
    
2433
    $dbi->select(
2434
        table => 'table1',
2435
        column => 'table1.key1 as table1_key1, key2, key3',
2436
        where   => {'table1.key2' => 3},
2437
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2438
                  ' as table2 on table1.key1 = table2.key1'],
2439
        param => {'table2.key3' => 5}
2440
    );
2441

            
2442
For example, if you want to contain tag in join clause, 
2443
you can pass parameter by C<param> option.
2444

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

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

            
2449
    $dbi->select(append => 'order by title');
2450

            
2451
=item C<filter>
2452

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

            
2457
    # Basic
2458
    $dbi->select(
2459
        filter => [
2460
            title  => sub { uc $_[0] }
2461
            author => sub { uc $_[0] }
2462
        ]
2463
    );
2464
    
2465
    # At once
2466
    $dbi->select(
2467
        filter => [
2468
            [qw/title author/]  => sub { uc $_[0] }
2469
        ]
2470
    );
2471
    
2472
    # Filter name
2473
    $dbi->select(
2474
        filter => [
2475
            title  => 'upper_case',
2476
            author => 'upper_case'
2477
        ]
2478
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2479

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

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

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

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

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

            
2491
    my $sql = $query->sql;
2492

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

            
2495
Specify database data type.
2496

            
2497
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2498
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2499

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

            
2502
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2503

            
update pod
Yuki Kimoto authored on 2011-03-12
2504
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2505

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

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

            
2510
    $dbi->select_at(
2511
        table => 'book',
2512
        primary_key => 'id',
2513
        where => '5'
2514
    );
2515

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2520
=over 4
2521

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2524
Primary key. This is constant value or array reference.
2525
    
2526
    # Constant value
2527
    $dbi->select(primary_key => 'id');
2528

            
2529
    # Array reference
2530
    $dbi->select(primary_key => ['id1', 'id2' ]);
2531

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

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

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

            
2539
    # Constant value
2540
    $dbi->select(where => 5);
2541

            
2542
    # Array reference
2543
    $dbi->select(where => [3, 5]);
2544

            
2545
In first examle, the following SQL is created.
2546

            
2547
    select * from book where id = ?
2548

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2551
=back
2552

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2555
    $dbi->update(
2556
        table  => 'book',
2557
        param  => {title => 'Perl'},
2558
        where  => {id => 4}
2559
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2560

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2565
=over 4
2566

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2569
Table name.
2570

            
2571
    $dbi->update(table => 'book');
2572

            
2573
=item C<param>
2574

            
2575
Update data. This is hash reference.
2576

            
2577
    $dbi->update(param => {title => 'Perl'});
2578

            
2579
=item C<where>
2580

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2581
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2582
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2583
    
2584
    # Hash reference
2585
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2586
    
2587
    # DBIx::Custom::Where object
2588
    my $where = $dbi->where(
2589
        clause => ['and', '{= author}', '{like title}'],
2590
        param  => {author => 'Ken', title => '%Perl%'}
2591
    );
2592
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2593
    
2594
    # Array refrendce (where clause and parameter)
2595
    $dbi->update(where =>
2596
        [
2597
            ['and', '{= author}', '{like title}'],
2598
            {author => 'Ken', title => '%Perl%'}
2599
        ]
2600
    );
update pod
Yuki Kimoto authored on 2011-03-13
2601

            
2602
=item C<append>
2603

            
2604
Append statement to last of SQL. This is string.
2605

            
2606
    $dbi->update(append => 'order by title');
2607

            
2608
=item C<filter>
2609

            
2610
Filter, executed before data is send to database. This is array reference.
2611
Filter value is code reference or
2612
filter name registerd by C<register_filter()>.
2613

            
2614
    # Basic
2615
    $dbi->update(
2616
        filter => [
2617
            title  => sub { uc $_[0] }
2618
            author => sub { uc $_[0] }
2619
        ]
2620
    );
2621
    
2622
    # At once
2623
    $dbi->update(
2624
        filter => [
2625
            [qw/title author/]  => sub { uc $_[0] }
2626
        ]
2627
    );
2628
    
2629
    # Filter name
2630
    $dbi->update(
2631
        filter => [
2632
            title  => 'upper_case',
2633
            author => 'upper_case'
2634
        ]
2635
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2636

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

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

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

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

            
2646
You can check SQL.
2647

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2650
=back
2651

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

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

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

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

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

            
2663
    $dbi->update_at(
2664
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2665
        primary_key => 'id',
2666
        where => '5',
2667
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2668
    );
2669

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2674
=over 4
2675

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

            
2678
Primary key. This is constant value or array reference.
2679
    
2680
    # Constant value
2681
    $dbi->update(primary_key => 'id');
2682

            
2683
    # Array reference
2684
    $dbi->update(primary_key => ['id1', 'id2' ]);
2685

            
2686
This is used to create where clause.
2687

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

            
2690
Where clause, created from primary key information.
2691
This is constant value or array reference.
2692

            
2693
    # Constant value
2694
    $dbi->update(where => 5);
2695

            
2696
    # Array reference
2697
    $dbi->update(where => [3, 5]);
2698

            
2699
In first examle, the following SQL is created.
2700

            
2701
    update book set title = ? where id = ?
2702

            
2703
Place holders are set to 'Perl' and 5.
2704

            
update pod
Yuki Kimoto authored on 2011-03-13
2705
=back
2706

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

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

            
2711
Create update parameter tag.
2712

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2718
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2719
        {title => 'a', age => 2}
2720
        {no_set => 1}
2721
    );
2722

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2727
    my $where = $dbi->where(
2728
        clause => ['and', '{= title}', '{= author}'],
2729
        param => {title => 'Perl', author => 'Ken'}
2730
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2731

            
2732
Create a new L<DBIx::Custom::Where> object.
2733

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2741
=head1 Tags
2742

            
2743
The following tags is available.
2744

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

            
2747
Table tag
2748

            
2749
    {table TABLE}    ->    TABLE
2750

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2753
=head2 C<?>
2754

            
2755
Placeholder tag.
2756

            
2757
    {? NAME}    ->   ?
2758

            
2759
=head2 C<=>
2760

            
2761
Equal tag.
2762

            
2763
    {= NAME}    ->   NAME = ?
2764

            
2765
=head2 C<E<lt>E<gt>>
2766

            
2767
Not equal tag.
2768

            
2769
    {<> NAME}   ->   NAME <> ?
2770

            
2771
=head2 C<E<lt>>
2772

            
2773
Lower than tag
2774

            
2775
    {< NAME}    ->   NAME < ?
2776

            
2777
=head2 C<E<gt>>
2778

            
2779
Greater than tag
2780

            
2781
    {> NAME}    ->   NAME > ?
2782

            
2783
=head2 C<E<gt>=>
2784

            
2785
Greater than or equal tag
2786

            
2787
    {>= NAME}   ->   NAME >= ?
2788

            
2789
=head2 C<E<lt>=>
2790

            
2791
Lower than or equal tag
2792

            
2793
    {<= NAME}   ->   NAME <= ?
2794

            
2795
=head2 C<like>
2796

            
2797
Like tag
2798

            
2799
    {like NAME}   ->   NAME like ?
2800

            
2801
=head2 C<in>
2802

            
2803
In tag.
2804

            
2805
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2806

            
2807
=head2 C<insert_param>
2808

            
2809
Insert parameter tag.
2810

            
2811
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2812

            
2813
=head2 C<update_param>
2814

            
2815
Updata parameter tag.
2816

            
2817
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2818

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

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

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

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

            
2828
C<< <kimoto.yuki at gmail.com> >>
2829

            
2830
L<http://github.com/yuki-kimoto/DBIx-Custom>
2831

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2832
=head1 AUTHOR
2833

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

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

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

            
2840
This program is free software; you can redistribute it and/or modify it
2841
under the same terms as Perl itself.
2842

            
2843
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2844

            
2845