DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2861 lines | 68.685kb
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 2011-04-02
543
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
544
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
545

            
cleanup
Yuki Kimoto authored on 2011-03-09
546
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
547
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
548
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
549
          unless $INSERT_ARGS{$name};
packaging one directory
yuki-kimoto authored on 2009-11-16
550
    }
551
    
cleanup
yuki-kimoto authored on 2010-10-17
552
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
553
    my $table  = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
554
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
555
    my $param  = delete $args{param} || {};
556
    my $append = delete $args{append} || '';
cleanup
yuki-kimoto authored on 2010-10-17
557
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
558
    # Columns
559
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
560
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
561
    foreach my $column (keys %$param) {
562
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
563
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
564
          $column = "$q$column$q";
565
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
566
        push @columns, $column;
567
    }
cleanup
yuki-kimoto authored on 2010-10-17
568
    
cleanup
Yuki Kimoto authored on 2011-01-27
569
    # SQL stack
570
    my @sql;
571
    
572
    # Insert
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
573
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
574
    push @sql, $append if $append;
575
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
576
    # SQL
cleanup
Yuki Kimoto authored on 2011-01-27
577
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
578
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
579
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
580
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
581
    return $query if $args{query};
582
    
packaging one directory
yuki-kimoto authored on 2009-11-16
583
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
584
    my $ret_val = $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
585
        $query,
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
586
        param  => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
587
        table => $table,
588
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
589
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
590
    
591
    return $ret_val;
592
}
593

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

            
596
sub insert_at {
597
    my ($self, %args) = @_;
598
    
cleanup
Yuki Kimoto authored on 2011-03-09
599
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
600
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
601
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
602
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
603
    }
604
    
605
    # Primary key
606
    my $primary_keys = delete $args{primary_key};
607
    $primary_keys = [$primary_keys] unless ref $primary_keys;
608
    
609
    # Where clause
610
    my $where = {};
611
    my $param = {};
612
    
613
    if (exists $args{where}) {
614
        my $where_columns = delete $args{where};
615
        $where_columns = [$where_columns] unless ref $where_columns;
616

            
617
        croak qq{"where" must be constant value or array reference}
618
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
619
        
620
        for(my $i = 0; $i < @$primary_keys; $i ++) {
621
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
622
        }
623
    }
624
    
625
    if (exists $args{param}) {
626
        $param = delete $args{param};
627
        for(my $i = 0; $i < @$primary_keys; $i ++) {
628
             delete $param->{$primary_keys->[$i]};
629
        }
630
    }
631
    
632
    $param = {%$param, %$where};
633
    
634
    return $self->insert(param => $param, %args);
635
}
636

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
637
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
638
    my ($self, $param) = @_;
639
    
update pod
Yuki Kimoto authored on 2011-03-13
640
    # Insert parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
641
    my @names;
642
    my @placeholders;
643
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
644
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
645
    my $q = $self->reserved_word_quote;
646
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
647
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
648
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
649
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
650
        
651
        my $c = "$q$column$q";
652
        $c =~ s/\./$q.$q/;
653
        
654
        push @names, $c;
655
        push @placeholders, "{? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
656
    }
657
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
658
    return '(' . join(', ', @names) . ') ' . 'values' .
659
           ' (' . join(', ', @placeholders) . ')';
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
660
}
661

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
662
sub include_model {
663
    my ($self, $name_space, $model_infos) = @_;
664
    
665
    $name_space ||= '';
666
    unless ($model_infos) {
667
        # Load name space module
668
        croak qq{"$name_space" is invalid class name}
669
          if $name_space =~ /[^\w:]/;
670
        eval "use $name_space";
671
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
672
        
673
        # Search model modules
674
        my $path = $INC{"$name_space.pm"};
675
        $path =~ s/\.pm$//;
676
        opendir my $dh, $path
677
          or croak qq{Can't open directory "$path": $!};
678
        $model_infos = [];
679
        while (my $module = readdir $dh) {
680
            push @$model_infos, $module
681
              if $module =~ s/\.pm$//;
682
        }
683
        
684
        close $dh;
685
    }
686
    
687
    foreach my $model_info (@$model_infos) {
688
        
689
        # Model class, name, table
690
        my $model_class;
691
        my $model_name;
692
        my $model_table;
693
        if (ref $model_info eq 'HASH') {
694
            $model_class = $model_info->{class};
695
            $model_name  = $model_info->{name};
696
            $model_table = $model_info->{table};
697
            
698
            $model_name  ||= $model_class;
699
            $model_table ||= $model_name;
700
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
701
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
702
        my $mclass = "${name_space}::$model_class";
703
        
704
        # Load
705
        croak qq{"$mclass" is invalid class name}
706
          if $mclass =~ /[^\w:]/;
707
        unless ($mclass->can('isa')) {
708
            eval "use $mclass";
709
            croak $@ if $@;
710
        }
711
        
712
        # Instantiate
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
713
        my $args = {};
714
        $args->{model_class} = $mclass if $mclass;
715
        $args->{name}        = $model_name if $model_name;
716
        $args->{table}       = $model_table if $model_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
717
        
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
718
        # Create model
719
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
720
    }
721
    
722
    return $self;
723
}
724

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
725
sub merge_param {
726
    my ($self, @params) = @_;
727
    
728
    my $param = {};
729
    
730
    foreach my $p (@params) {
731
        foreach my $column (keys %$p) {
732
            if (exists $param->{$column}) {
733
                $param->{$column} = [$param->{$column}]
734
                  unless ref $param->{$column} eq 'ARRAY';
735
                push @{$param->{$column}}, $p->{$column};
736
            }
737
            else {
738
                $param->{$column} = $p->{$column};
739
            }
740
        }
741
    }
742
    
743
    return $param;
744
}
745

            
cleanup
Yuki Kimoto authored on 2011-03-21
746
sub method {
747
    my $self = shift;
748
    
749
    # Merge
750
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
751
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
752
    
753
    return $self;
754
}
755

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
756
sub model {
757
    my ($self, $name, $model) = @_;
758
    
759
    # Set
760
    if ($model) {
761
        $self->models->{$name} = $model;
762
        return $self;
763
    }
764
    
765
    # Check model existance
766
    croak qq{Model "$name" is not included}
767
      unless $self->models->{$name};
768
    
769
    # Get
770
    return $self->models->{$name};
771
}
772

            
cleanup
Yuki Kimoto authored on 2011-03-21
773
sub mycolumn {
774
    my ($self, $table, $columns) = @_;
775
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
776
    my $q = $self->reserved_word_quote;
777
    
cleanup
Yuki Kimoto authored on 2011-03-21
778
    $columns ||= [];
779
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
780
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
781
    
782
    return join (', ', @column);
783
}
784

            
added dbi_options attribute
kimoto authored on 2010-12-20
785
sub new {
786
    my $self = shift->SUPER::new(@_);
787
    
788
    # Check attribute names
789
    my @attrs = keys %$self;
790
    foreach my $attr (@attrs) {
791
        croak qq{"$attr" is invalid attribute name}
792
          unless $self->can($attr);
793
    }
cleanup
Yuki Kimoto authored on 2011-01-25
794

            
795
    $self->register_tag(
796
        '?'     => \&DBIx::Custom::Tag::placeholder,
797
        '='     => \&DBIx::Custom::Tag::equal,
798
        '<>'    => \&DBIx::Custom::Tag::not_equal,
799
        '>'     => \&DBIx::Custom::Tag::greater_than,
800
        '<'     => \&DBIx::Custom::Tag::lower_than,
801
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
802
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
803
        'like'  => \&DBIx::Custom::Tag::like,
804
        'in'    => \&DBIx::Custom::Tag::in,
805
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
806
        'update_param' => \&DBIx::Custom::Tag::update_param
807
    );
added dbi_options attribute
kimoto authored on 2010-12-20
808
    
809
    return $self;
810
}
811

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

            
cleanup
yuki-kimoto authored on 2010-10-17
814
sub register_filter {
815
    my $invocant = shift;
816
    
817
    # Register filter
818
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
819
    $invocant->filters({%{$invocant->filters}, %$filters});
820
    
821
    return $invocant;
822
}
packaging one directory
yuki-kimoto authored on 2009-11-16
823

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
826
sub replace {
827
    my ($self, $join, $search, $replace) = @_;
828
    
829
    my @replace_join;
830
    my $is_replaced;
831
    foreach my $j (@$join) {
832
        if ($search eq $j) {
833
            push @replace_join, $replace;
834
            $is_replaced = 1;
835
        }
836
        else {
837
            push @replace_join, $j;
838
        }
839
    }
840
    croak qq{Can't replace "$search" with "$replace"} unless $is_replaced;
841
    
842
    return @replace_join;
843
}
844

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

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

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

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

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

            
958
sub select_at {
959
    my ($self, %args) = @_;
960
    
cleanup
Yuki Kimoto authored on 2011-03-09
961
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
962
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
963
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
964
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
965
    }
966
    
967
    # Primary key
968
    my $primary_keys = delete $args{primary_key};
969
    $primary_keys = [$primary_keys] unless ref $primary_keys;
970
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
971
    # Table
972
    croak qq{"table" option must be specified} unless $args{table};
973
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
974
    
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
975
    # Where clause
976
    my $where = {};
977
    if (exists $args{where}) {
978
        my $where_columns = delete $args{where};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
979
        
980
        croak qq{"where" must be constant value or array reference}
981
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
982
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
983
        $where_columns = [$where_columns] unless ref $where_columns;
984
        
985
        for(my $i = 0; $i < @$primary_keys; $i ++) {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
986
           $where->{$table . '.' . $primary_keys->[$i]} = $where_columns->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
987
        }
988
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
989
    
990
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
991
        my $param = delete $args{param};
992
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
993
             delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
994
        }
995
    }
996
    
997
    return $self->select(where => $where, %args);
998
}
999

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1000
sub setup_model {
1001
    my $self = shift;
1002
    
1003
    $self->each_column(
1004
        sub {
1005
            my ($self, $table, $column, $column_info) = @_;
1006
            
1007
            if (my $model = $self->models->{$table}) {
1008
                push @{$model->columns}, $column;
1009
            }
1010
        }
1011
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1012
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1013
}
1014

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

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

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

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

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

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

            
1105
sub update_at {
1106
    my ($self, %args) = @_;
1107
    
cleanup
Yuki Kimoto authored on 2011-03-09
1108
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1109
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1110
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1111
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1112
    }
1113
    
1114
    # Primary key
1115
    my $primary_keys = delete $args{primary_key};
1116
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1117
    
1118
    # Where clause
1119
    my $where = {};
1120
    my $param = {};
1121
    
1122
    if (exists $args{where}) {
1123
        my $where_columns = delete $args{where};
1124
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1125

            
1126
        croak qq{"where" must be constant value or array reference}
1127
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1128
        
1129
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1130
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1131
        }
1132
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1133
    
1134
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1135
        $param = delete $args{param};
1136
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1137
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1138
        }
1139
    }
1140
    
1141
    return $self->update(where => $where, param => $param, %args);
1142
}
1143

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1144
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1145
    my ($self, $param, $opt) = @_;
1146
    
1147
    # Insert parameter tag
1148
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1149
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1150
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1151
    my $q = $self->reserved_word_quote;
1152
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1153
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1154
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1155
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1156
        
1157
        my $c = "$q$column$q";
1158
        $c =~ s/\./$q.$q/;
1159
        
1160
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1161
    }
1162
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1163
    my $clause;
1164
    $clause .= 'set ' unless $opt->{no_set};
1165
    $clause .= join(', ', @params);
1166
    
1167
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1168
}
1169

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

            
1173
    return DBIx::Custom::Where->new(
1174
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1175
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1176
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1177
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1178
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1179
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1180

            
cleanup
Yuki Kimoto authored on 2011-04-02
1181
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1182
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1183
    
cleanup
Yuki Kimoto authored on 2011-01-12
1184
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1185
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1186
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1187
    # Build bind values
1188
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1189
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1190
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1191
        
1192
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1193
        my $value;
1194
        if(ref $params->{$column} eq 'ARRAY') {
1195
            my $i = $count->{$column} || 0;
1196
            $i += $not_exists->{$column} || 0;
1197
            my $found;
1198
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1199
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1200
                    $not_exists->{$column}++;
1201
                }
1202
                else  {
1203
                    $value = $params->{$column}->[$k];
1204
                    $found = 1;
1205
                    last
1206
                }
1207
            }
1208
            next unless $found;
1209
        }
1210
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1211
        
cleanup
Yuki Kimoto authored on 2011-01-12
1212
        # Filter
1213
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1214
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1215
        # Type
1216
        push @$bind, {
1217
            value => $f ? $f->($value) : $value,
1218
            type => $type->{$column}
1219
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1220
        
1221
        # Count up 
1222
        $count->{$column}++;
1223
    }
1224
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1225
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1226
}
1227

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1228
sub _connect {
1229
    my $self = shift;
1230
    
1231
    # Attributes
1232
    my $data_source = $self->data_source;
1233
    croak qq{"data_source" must be specified to connect()"}
1234
      unless $data_source;
1235
    my $user        = $self->user;
1236
    my $password    = $self->password;
1237
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1238
    
1239
    # Connect
1240
    my $dbh = eval {DBI->connect(
1241
        $data_source,
1242
        $user,
1243
        $password,
1244
        {
1245
            %{$self->default_dbi_option},
1246
            %$dbi_option
1247
        }
1248
    )};
1249
    
1250
    # Connect error
1251
    croak $@ if $@;
1252
    
1253
    return $dbh;
1254
}
1255

            
cleanup
yuki-kimoto authored on 2010-10-17
1256
sub _croak {
1257
    my ($self, $error, $append) = @_;
1258
    $append ||= "";
1259
    
1260
    # Verbose
1261
    if ($Carp::Verbose) { croak $error }
1262
    
1263
    # Not verbose
1264
    else {
1265
        
1266
        # Remove line and module infromation
1267
        my $at_pos = rindex($error, ' at ');
1268
        $error = substr($error, 0, $at_pos);
1269
        $error =~ s/\s+$//;
1270
        
1271
        croak "$error$append";
1272
    }
1273
}
1274

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1275
sub _need_tables {
1276
    my ($self, $tree, $need_tables, $tables) = @_;
1277
    
1278
    foreach my $table (@$tables) {
1279
        
1280
        if ($tree->{$table}) {
1281
            $need_tables->{$table} = 1;
1282
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1283
        }
1284
    }
1285
}
1286

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1287
sub _push_join {
1288
    my ($self, $sql, $join, $join_tables) = @_;
1289
    
1290
    return unless @$join;
1291
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1292
    my $q = $self->reserved_word_quote;
1293
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1294
    my $tree = {};
1295
    
1296
    for (my $i = 0; $i < @$join; $i++) {
1297
        
1298
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1299
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1300
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1301
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1302
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1303
            
1304
            my $table1 = $1;
1305
            my $table2 = $2;
1306
            
1307
            croak qq{right side table of "$join_clause" must be uniq}
1308
              if exists $tree->{$table2};
1309
            
1310
            $tree->{$table2}
1311
              = {position => $i, parent => $table1, join => $join_clause};
1312
        }
1313
        else {
1314
            croak qq{join "$join_clause" must be two table name};
1315
        }
1316
    }
1317
    
1318
    my $need_tables = {};
1319
    $self->_need_tables($tree, $need_tables, $join_tables);
1320
    
1321
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1322

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1323
    foreach my $need_table (@need_tables) {
1324
        push @$sql, $tree->{$need_table}{join};
1325
    }
1326
}
cleanup
Yuki Kimoto authored on 2011-03-08
1327

            
cleanup
Yuki Kimoto authored on 2011-04-02
1328
sub _remove_duplicate_table {
1329
    my ($self, $tables, $main_table) = @_;
1330
    
1331
    # Remove duplicate table
1332
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1333
    delete $tables{$main_table} if $main_table;
1334
    
1335
    return [keys %tables, $main_table ? $main_table : ()];
1336
}
1337

            
1338
sub _tables {
1339
    my ($self, $source) = @_;
1340
    
1341
    my $tables = [];
1342
    
1343
    my $safety_character = $self->safety_character;
1344
    my $q = $self->reserved_word_quote;
1345
    my $q_re = quotemeta($q);
1346
    
1347
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1348
                      : qr/\b([$safety_character]+)\./;
1349
    while ($source =~ /$table_re/g) {
1350
        push @$tables, $1;
1351
    }
1352
    
1353
    return $tables;
1354
}
1355

            
cleanup
Yuki Kimoto authored on 2011-04-02
1356
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1357
    my ($self, $where) = @_;
1358
    
1359
    my $w;
1360
    if (ref $where eq 'HASH') {
1361
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1362
        my $q = $self->reserved_word_quote;
1363
        foreach my $column (keys %$where) {
1364
            $column = "$q$column$q";
1365
            $column =~ s/\./$q.$q/;
1366
            push @$clause, "{= $column}" for keys %$where;
1367
        }
1368
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1369
        $w = $self->where(clause => $clause, param => $where);
1370
    }
1371
    elsif (ref $where eq 'DBIx::Custom::Where') {
1372
        $w = $where;
1373
    }
1374
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1375
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1376
             "use \$dbi->select(where => \$dbi->where(clause => " .
1377
             "CLAUSE, param => PARAMETER));";
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1378
        $w = $self->where(
1379
            clause => $where->[0],
1380
            param  => $where->[1]
1381
        );
1382
    }
1383
    
1384
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1385
          qq{or array reference, which contains where clause and paramter}
1386
      unless ref $w eq 'DBIx::Custom::Where';
1387
    
1388
    return $w;
1389
}
1390

            
cleanup
Yuki Kimoto authored on 2011-01-25
1391
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1392
__PACKAGE__->attr(
1393
    dbi_options => sub { {} },
1394
    filter_check  => 1
1395
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1396

            
cleanup
Yuki Kimoto authored on 2011-01-25
1397
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1398
sub default_bind_filter {
1399
    my $self = shift;
1400
    
1401
    if (@_) {
1402
        my $fname = $_[0];
1403
        
1404
        if (@_ && !$fname) {
1405
            $self->{default_out_filter} = undef;
1406
        }
1407
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1408
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1409
              unless exists $self->filters->{$fname};
1410
        
1411
            $self->{default_out_filter} = $self->filters->{$fname};
1412
        }
1413
        return $self;
1414
    }
1415
    
1416
    return $self->{default_out_filter};
1417
}
1418

            
cleanup
Yuki Kimoto authored on 2011-01-25
1419
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1420
sub default_fetch_filter {
1421
    my $self = shift;
1422
    
1423
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1424
        my $fname = $_[0];
1425

            
cleanup
Yuki Kimoto authored on 2011-01-12
1426
        if (@_ && !$fname) {
1427
            $self->{default_in_filter} = undef;
1428
        }
1429
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1430
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1431
              unless exists $self->filters->{$fname};
1432
        
1433
            $self->{default_in_filter} = $self->filters->{$fname};
1434
        }
1435
        
1436
        return $self;
1437
    }
1438
    
many changed
Yuki Kimoto authored on 2011-01-23
1439
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1440
}
1441

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1442
# DEPRECATED!
1443
sub insert_param {
1444
    warn "insert_param is renamed to insert_param_tag."
1445
       . " insert_param is DEPRECATED!";
1446
    return shift->insert_param_tag(@_);
1447
}
1448

            
cleanup
Yuki Kimoto authored on 2011-01-25
1449
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1450
sub register_tag_processor {
1451
    return shift->query_builder->register_tag_processor(@_);
1452
}
1453

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1454
# DEPRECATED!
1455
sub update_param {
1456
    warn "update_param is renamed to update_param_tag."
1457
       . " update_param is DEPRECATED!";
1458
    return shift->update_param_tag(@_);
1459
}
cleanup
Yuki Kimoto authored on 2011-03-08
1460
# DEPRECATED!
1461
sub _push_relation {
1462
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1463
    
1464
    if (keys %{$relation || {}}) {
1465
        push @$sql, $need_where ? 'where' : 'and';
1466
        foreach my $rcolumn (keys %$relation) {
1467
            my $table1 = (split (/\./, $rcolumn))[0];
1468
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1469
            push @$tables, ($table1, $table2);
1470
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1471
        }
1472
    }
1473
    pop @$sql if $sql->[-1] eq 'and';    
1474
}
1475

            
1476
# DEPRECATED!
1477
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1478
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1479
    
1480
    if (keys %{$relation || {}}) {
1481
        foreach my $rcolumn (keys %$relation) {
1482
            my $table1 = (split (/\./, $rcolumn))[0];
1483
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1484
            my $table1_exists;
1485
            my $table2_exists;
1486
            foreach my $table (@$tables) {
1487
                $table1_exists = 1 if $table eq $table1;
1488
                $table2_exists = 1 if $table eq $table2;
1489
            }
1490
            unshift @$tables, $table1 unless $table1_exists;
1491
            unshift @$tables, $table2 unless $table2_exists;
1492
        }
1493
    }
1494
}
1495

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1498
=head1 NAME
1499

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

            
1502
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1503

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1504
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1505
    
1506
    # Connect
1507
    my $dbi = DBIx::Custom->connect(
1508
        data_source => "dbi:mysql:database=dbname",
1509
        user => 'ken',
1510
        password => '!LFKD%$&',
1511
        dbi_option => {mysql_enable_utf8 => 1}
1512
    );
cleanup
yuki-kimoto authored on 2010-08-05
1513

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1514
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1515
    $dbi->insert(
1516
        table  => 'book',
1517
        param  => {title => 'Perl', author => 'Ken'}
1518
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1519
    
1520
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1521
    $dbi->update(
1522
        table  => 'book', 
1523
        param  => {title => 'Perl', author => 'Ken'}, 
1524
        where  => {id => 5},
1525
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1526
    
1527
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1528
    $dbi->delete(
1529
        table  => 'book',
1530
        where  => {author => 'Ken'},
1531
    );
cleanup
yuki-kimoto authored on 2010-08-05
1532

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1539
    # Select, more complex
1540
    my $result = $dbi->select(
1541
        table  => 'book',
1542
        column => [
1543
            'book.author as book__author',
1544
            'company.name as company__name'
1545
        ],
1546
        where  => {'book.author' => 'Ken'},
1547
        join => ['left outer join company on book.company_id = company.id'],
1548
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1549
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1550
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1551
    # Fetch
1552
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1553
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1554
    }
1555
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1556
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1557
    while (my $row = $result->fetch_hash) {
1558
        
1559
    }
1560
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1561
    # Execute SQL with parameter.
1562
    $dbi->execute(
1563
        "select id from book where {= author} and {like title}",
1564
        param  => {author => 'ken', title => '%Perl%'}
1565
    );
1566
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1567
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1568

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

            
1571
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1572

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1577
There are many basic methods to execute various queries.
1578
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1579
C<delete_all()>, C<select()>,
1580
C<insert_at()>, C<update_at()>, 
1581
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1582

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1583
=item *
1584

            
1585
Filter when data is send or receive.
1586

            
1587
=item *
1588

            
1589
Data filtering system
1590

            
1591
=item *
1592

            
1593
Model support.
1594

            
1595
=item *
1596

            
1597
Generate where clause dinamically.
1598

            
1599
=item *
1600

            
1601
Generate join clause dinamically.
1602

            
1603
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1604

            
1605
=head1 GUIDE
1606

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

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

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

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

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

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

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

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

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

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

            
1630
=head2 C<default_dbi_option>
1631

            
1632
    my $default_dbi_option = $dbi->default_dbi_option;
1633
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1634

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1638
    {
1639
        RaiseError => 1,
1640
        PrintError => 0,
1641
        AutoCommit => 1,
1642
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1643

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

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

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

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

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

            
1656
    my $models = $dbi->models;
1657
    $dbi       = $dbi->models(\%models);
1658

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1661
=head2 C<password>
1662

            
1663
    my $password = $dbi->password;
1664
    $dbi         = $dbi->password('lkj&le`@s');
1665

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

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

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

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

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

            
1677
     my reserved_word_quote = $dbi->reserved_word_quote;
1678
     $dbi                   = $dbi->reserved_word_quote('"');
1679

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1699
    my $user = $dbi->user;
1700
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1701

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1712
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1713
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1714
        'issue_date' => {
1715
            out => 'tp_to_date',
1716
            in  => 'date_to_tp',
1717
            end => 'tp_to_displaydate'
1718
        },
1719
        'write_date' => {
1720
            out => 'tp_to_date',
1721
            in  => 'date_to_tp',
1722
            end => 'tp_to_displaydate'
1723
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1724
    );
1725

            
update pod
Yuki Kimoto authored on 2011-03-13
1726
Apply filter to columns.
1727
C<out> filter is executed before data is send to database.
1728
C<in> filter is executed after a row is fetch.
1729
C<end> filter is execute after C<in> filter is executed.
1730

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1733
       PETTERN         EXAMPLE
1734
    1. Column        : author
1735
    2. Table.Column  : book.author
1736
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1737

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

            
1741
You can set multiple filters at once.
1742

            
1743
    $dbi->apply_filter(
1744
        'book',
1745
        [qw/issue_date write_date/] => {
1746
            out => 'tp_to_date',
1747
            in  => 'date_to_tp',
1748
            end => 'tp_to_displaydate'
1749
        }
1750
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1751

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1754
    my $dbi = DBIx::Custom->connect(
1755
        data_source => "dbi:mysql:database=dbname",
1756
        user => 'ken',
1757
        password => '!LFKD%$&',
1758
        dbi_option => {mysql_enable_utf8 => 1}
1759
    );
1760

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1769
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1770
        table => 'book',
1771
        primary_key => 'id',
1772
        join => [
1773
            'inner join company on book.comparny_id = company.id'
1774
        ],
1775
        filter => [
1776
            publish_date => {
1777
                out => 'tp_to_date',
1778
                in => 'date_to_tp',
1779
                end => 'tp_to_displaydate'
1780
            }
1781
        ]
1782
    );
1783

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

            
1787
   $dbi->model('book')->select(...);
1788

            
cleanup
yuki-kimoto authored on 2010-10-17
1789
=head2 C<create_query>
1790
    
1791
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1792
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1793
    );
update document
yuki-kimoto authored on 2009-11-19
1794

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

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

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

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

            
1805
    my $dbh = $dbi->dbh;
1806
    $dbi    = $dbi->dbh($dbh);
1807

            
1808
Get and set database handle of L<DBI>.
1809

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

            
1812
=head2 C<each_column>
1813

            
1814
    $dbi->each_column(
1815
        sub {
1816
            my ($dbi, $table, $column, $column_info) = @_;
1817
            
1818
            my $type = $column_info->{TYPE_NAME};
1819
            
1820
            if ($type eq 'DATE') {
1821
                # ...
1822
            }
1823
        }
1824
    );
1825

            
1826
Iterate all column informations of all table from database.
1827
Argument is callback when one column is found.
1828
Callback receive four arguments, dbi object, table name,
1829
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1830

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1833
    my $result = $dbi->execute(
1834
        "select * from book where {= title} and {like author}",
1835
        param => {title => 'Perl', author => '%Ken%'}
1836
    );
1837

            
1838
Execute SQL, containing tags.
1839
Return value is L<DBIx::Custom::Result> in select statement, or
1840
the count of affected rows in insert, update, delete statement.
1841

            
1842
Tag is turned into the statement containing place holder
1843
before SQL is executed.
1844

            
1845
    select * from where title = ? and author like ?;
1846

            
1847
See also L<Tags/Tags>.
1848

            
1849
The following opitons are currently available.
1850

            
1851
=over 4
1852

            
1853
=item C<filter>
1854

            
1855
Filter, executed before data is send to database. This is array reference.
1856
Filter value is code reference or
1857
filter name registerd by C<register_filter()>.
1858

            
1859
    # Basic
1860
    $dbi->execute(
1861
        $sql,
1862
        filter => [
1863
            title  => sub { uc $_[0] }
1864
            author => sub { uc $_[0] }
1865
        ]
1866
    );
1867
    
1868
    # At once
1869
    $dbi->execute(
1870
        $sql,
1871
        filter => [
1872
            [qw/title author/]  => sub { uc $_[0] }
1873
        ]
1874
    );
1875
    
1876
    # Filter name
1877
    $dbi->execute(
1878
        $sql,
1879
        filter => [
1880
            title  => 'upper_case',
1881
            author => 'upper_case'
1882
        ]
1883
    );
1884

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

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

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

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

            
1893
Delete statement.
1894

            
1895
The following opitons are currently available.
1896

            
update pod
Yuki Kimoto authored on 2011-03-13
1897
=over 4
1898

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

            
1901
Table name.
1902

            
1903
    $dbi->delete(table => 'book');
1904

            
1905
=item C<where>
1906

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1907
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1908
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1909
    
1910
    # Hash reference
1911
    $dbi->delete(where => {title => 'Perl'});
1912
    
1913
    # DBIx::Custom::Where object
1914
    my $where = $dbi->where(
1915
        clause => ['and', '{= author}', '{like title}'],
1916
        param  => {author => 'Ken', title => '%Perl%'}
1917
    );
1918
    $dbi->delete(where => $where);
1919

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1920
    # Array refrendce (where clause and parameter)
1921
    $dbi->delete(where =>
1922
        [
1923
            ['and', '{= author}', '{like title}'],
1924
            {author => 'Ken', title => '%Perl%'}
1925
        ]
1926
    );
1927
    
update pod
Yuki Kimoto authored on 2011-03-13
1928
=item C<append>
1929

            
1930
Append statement to last of SQL. This is string.
1931

            
1932
    $dbi->delete(append => 'order by title');
1933

            
1934
=item C<filter>
1935

            
1936
Filter, executed before data is send to database. This is array reference.
1937
Filter value is code reference or
1938
filter name registerd by C<register_filter()>.
1939

            
1940
    # Basic
1941
    $dbi->delete(
1942
        filter => [
1943
            title  => sub { uc $_[0] }
1944
            author => sub { uc $_[0] }
1945
        ]
1946
    );
1947
    
1948
    # At once
1949
    $dbi->delete(
1950
        filter => [
1951
            [qw/title author/]  => sub { uc $_[0] }
1952
        ]
1953
    );
1954
    
1955
    # Filter name
1956
    $dbi->delete(
1957
        filter => [
1958
            title  => 'upper_case',
1959
            author => 'upper_case'
1960
        ]
1961
    );
1962

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

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

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

            
1969
Create column clause. The follwoing column clause is created.
1970

            
1971
    book.author as book__author,
1972
    book.title as book__title
1973

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

            
1976
Get L<DBIx::Custom::Query> object instead of executing SQL.
1977
This is true or false value.
1978

            
1979
    my $query = $dbi->delete(query => 1);
1980

            
1981
You can check SQL.
1982

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1985
=back
1986

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

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

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

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

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

            
1998
    $dbi->delete_at(
1999
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2000
        primary_key => 'id',
2001
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2002
    );
2003

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2008
=over 4
2009

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2012
Primary key. This is constant value or array reference.
2013
    
2014
    # Constant value
2015
    $dbi->delete(primary_key => 'id');
2016

            
2017
    # Array reference
2018
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2019

            
2020
This is used to create where clause.
2021

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

            
2024
Where clause, created from primary key information.
2025
This is constant value or array reference.
2026

            
2027
    # Constant value
2028
    $dbi->delete(where => 5);
2029

            
2030
    # Array reference
2031
    $dbi->delete(where => [3, 5]);
2032

            
2033
In first examle, the following SQL is created.
2034

            
2035
    delete from book where id = ?;
2036

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2039
=back
2040

            
cleanup
yuki-kimoto authored on 2010-10-17
2041
=head2 C<insert>
2042

            
update pod
Yuki Kimoto authored on 2011-03-13
2043
    $dbi->insert(
2044
        table  => 'book', 
2045
        param  => {title => 'Perl', author => 'Ken'}
2046
    );
2047

            
2048
Insert statement.
2049

            
2050
The following opitons are currently available.
2051

            
update pod
Yuki Kimoto authored on 2011-03-13
2052
=over 4
2053

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

            
2056
Table name.
2057

            
2058
    $dbi->insert(table => 'book');
2059

            
2060
=item C<param>
2061

            
2062
Insert data. This is hash reference.
2063

            
2064
    $dbi->insert(param => {title => 'Perl'});
2065

            
2066
=item C<append>
2067

            
2068
Append statement to last of SQL. This is string.
2069

            
2070
    $dbi->insert(append => 'order by title');
2071

            
2072
=item C<filter>
2073

            
2074
Filter, executed before data is send to database. This is array reference.
2075
Filter value is code reference or
2076
filter name registerd by C<register_filter()>.
2077

            
2078
    # Basic
2079
    $dbi->insert(
2080
        filter => [
2081
            title  => sub { uc $_[0] }
2082
            author => sub { uc $_[0] }
2083
        ]
2084
    );
2085
    
2086
    # At once
2087
    $dbi->insert(
2088
        filter => [
2089
            [qw/title author/]  => sub { uc $_[0] }
2090
        ]
2091
    );
2092
    
2093
    # Filter name
2094
    $dbi->insert(
2095
        filter => [
2096
            title  => 'upper_case',
2097
            author => 'upper_case'
2098
        ]
2099
    );
2100

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

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

            
2105
Get L<DBIx::Custom::Query> object instead of executing SQL.
2106
This is true or false value.
2107

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2114
=back
2115

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

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

            
2120
    $dbi->insert_at(
2121
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2122
        primary_key => 'id',
2123
        where => '5',
2124
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2125
    );
2126

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2131
=over 4
2132

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

            
2135
Primary key. This is constant value or array reference.
2136
    
2137
    # Constant value
2138
    $dbi->insert(primary_key => 'id');
2139

            
2140
    # Array reference
2141
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2142

            
2143
This is used to create parts of insert data.
2144

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

            
2147
Parts of Insert data, create from primary key information.
2148
This is constant value or array reference.
2149

            
2150
    # Constant value
2151
    $dbi->insert(where => 5);
2152

            
2153
    # Array reference
2154
    $dbi->insert(where => [3, 5]);
2155

            
2156
In first examle, the following SQL is created.
2157

            
2158
    insert into book (id, title) values (?, ?);
2159

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2162
=back
2163

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

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

            
2168
Create insert parameter tag.
2169

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2179
    lib / MyModel.pm
2180
        / MyModel / book.pm
2181
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2182

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

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

            
2187
    package MyModel;
2188
    
2189
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2190
    
2191
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2192

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2197
    package MyModel::book;
2198
    
2199
    use base 'MyModel';
2200
    
2201
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2202

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2205
    package MyModel::company;
2206
    
2207
    use base 'MyModel';
2208
    
2209
    1;
2210
    
2211
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2212

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

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

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

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

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

            
2224
Merge paramters.
2225

            
2226
$param:
2227

            
2228
    {key1 => [1, 1], key2 => 2}
2229

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

            
2232
    $dbi->method(
2233
        update_or_insert => sub {
2234
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2235
            
2236
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2237
        },
2238
        find_or_create   => sub {
2239
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2240
            
2241
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2242
        }
2243
    );
2244

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

            
2247
    $dbi->update_or_insert;
2248
    $dbi->find_or_create;
2249

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

            
2252
    $dbi->model('book')->method(
2253
        insert => sub { ... },
2254
        update => sub { ... }
2255
    );
2256
    
2257
    my $model = $dbi->model('book');
2258

            
2259
Set and get a L<DBIx::Custom::Model> object,
2260

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

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

            
2265
Create column clause for myself. The follwoing column clause is created.
2266

            
2267
    book.author as author,
2268
    book.title as title
2269

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2272
    my $dbi = DBIx::Custom->new(
2273
        data_source => "dbi:mysql:database=dbname",
2274
        user => 'ken',
2275
        password => '!LFKD%$&',
2276
        dbi_option => {mysql_enable_utf8 => 1}
2277
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2278

            
2279
Create a new L<DBIx::Custom> object.
2280

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

            
2283
    my $not_exists = $dbi->not_exists;
2284

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2288
=head2 C<register_filter>
2289

            
update pod
Yuki Kimoto authored on 2011-03-13
2290
    $dbi->register_filter(
2291
        # Time::Piece object to database DATE format
2292
        tp_to_date => sub {
2293
            my $tp = shift;
2294
            return $tp->strftime('%Y-%m-%d');
2295
        },
2296
        # database DATE format to Time::Piece object
2297
        date_to_tp => sub {
2298
           my $date = shift;
2299
           return Time::Piece->strptime($date, '%Y-%m-%d');
2300
        }
2301
    );
cleanup
yuki-kimoto authored on 2010-10-17
2302
    
update pod
Yuki Kimoto authored on 2011-03-13
2303
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2304

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2307
    $dbi->register_tag(
2308
        update => sub {
2309
            my @columns = @_;
2310
            
2311
            # Update parameters
2312
            my $s = 'set ';
2313
            $s .= "$_ = ?, " for @columns;
2314
            $s =~ s/, $//;
2315
            
2316
            return [$s, \@columns];
2317
        }
2318
    );
cleanup
yuki-kimoto authored on 2010-10-17
2319

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2341
=head2 C<replace> EXPERIMENTAL
2342
    
2343
    my $join = [
2344
        'left outer join table2 on table1.key1 = table2.key1',
2345
        'left outer join table3 on table2.key3 = table3.key3'
2346
    ];
2347
    $join = $dbi->replace(
2348
        $join,
2349
        'left outer join table2 on table1.key1 = table2.key1',
2350
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2351
          'as table2 on table1.key1 = table2.key1'
2352
    );
2353

            
2354
Replace join clauses if match the expression.
2355

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2358
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2359
        table  => 'book',
2360
        column => ['author', 'title'],
2361
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2362
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2363
    
update pod
Yuki Kimoto authored on 2011-03-12
2364
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2365

            
2366
The following opitons are currently available.
2367

            
2368
=over 4
2369

            
2370
=item C<table>
2371

            
2372
Table name.
2373

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

            
2376
=item C<column>
2377

            
2378
Column clause. This is array reference or constant value.
2379

            
2380
    # Hash refernce
2381
    $dbi->select(column => ['author', 'title']);
2382
    
2383
    # Constant value
2384
    $dbi->select(column => 'author');
2385

            
2386
Default is '*' unless C<column> is specified.
2387

            
2388
    # Default
2389
    $dbi->select(column => '*');
2390

            
2391
=item C<where>
2392

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2393
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2394
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2395
    
2396
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2397
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2398
    
update pod
Yuki Kimoto authored on 2011-03-12
2399
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2400
    my $where = $dbi->where(
2401
        clause => ['and', '{= author}', '{like title}'],
2402
        param  => {author => 'Ken', title => '%Perl%'}
2403
    );
update pod
Yuki Kimoto authored on 2011-03-12
2404
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2405

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2406
    # Array refrendce (where clause and parameter)
2407
    $dbi->select(where =>
2408
        [
2409
            ['and', '{= author}', '{like title}'],
2410
            {author => 'Ken', title => '%Perl%'}
2411
        ]
2412
    );
2413
    
update pod
Yuki Kimoto authored on 2011-03-13
2414
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2415

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

            
2418
    $dbi->select(join =>
2419
        [
2420
            'left outer join company on book.company_id = company_id',
2421
            'left outer join location on company.location_id = location.id'
2422
        ]
2423
    );
2424

            
2425
If column cluase or where clause contain table name like "company.name",
2426
needed join clause is used automatically.
2427

            
2428
    $dbi->select(
2429
        table => 'book',
2430
        column => ['company.location_id as company__location_id'],
2431
        where => {'company.name' => 'Orange'},
2432
        join => [
2433
            'left outer join company on book.company_id = company.id',
2434
            'left outer join location on company.location_id = location.id'
2435
        ]
2436
    );
2437

            
2438
In above select, the following SQL is created.
2439

            
2440
    select company.location_id as company__location_id
2441
    from book
2442
      left outer join company on book.company_id = company.id
2443
    where company.name = Orange
2444

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

            
2447
Parameter shown before where clause.
2448
    
2449
    $dbi->select(
2450
        table => 'table1',
2451
        column => 'table1.key1 as table1_key1, key2, key3',
2452
        where   => {'table1.key2' => 3},
2453
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2454
                  ' as table2 on table1.key1 = table2.key1'],
2455
        param => {'table2.key3' => 5}
2456
    );
2457

            
2458
For example, if you want to contain tag in join clause, 
2459
you can pass parameter by C<param> option.
2460

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

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

            
2465
    $dbi->select(append => 'order by title');
2466

            
2467
=item C<filter>
2468

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

            
2473
    # Basic
2474
    $dbi->select(
2475
        filter => [
2476
            title  => sub { uc $_[0] }
2477
            author => sub { uc $_[0] }
2478
        ]
2479
    );
2480
    
2481
    # At once
2482
    $dbi->select(
2483
        filter => [
2484
            [qw/title author/]  => sub { uc $_[0] }
2485
        ]
2486
    );
2487
    
2488
    # Filter name
2489
    $dbi->select(
2490
        filter => [
2491
            title  => 'upper_case',
2492
            author => 'upper_case'
2493
        ]
2494
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2495

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

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

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

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

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

            
2507
    my $sql = $query->sql;
2508

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

            
2511
Specify database data type.
2512

            
2513
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2514
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2515

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

            
2518
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2519

            
update pod
Yuki Kimoto authored on 2011-03-12
2520
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2521

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

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

            
2526
    $dbi->select_at(
2527
        table => 'book',
2528
        primary_key => 'id',
2529
        where => '5'
2530
    );
2531

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2536
=over 4
2537

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2540
Primary key. This is constant value or array reference.
2541
    
2542
    # Constant value
2543
    $dbi->select(primary_key => 'id');
2544

            
2545
    # Array reference
2546
    $dbi->select(primary_key => ['id1', 'id2' ]);
2547

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

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

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

            
2555
    # Constant value
2556
    $dbi->select(where => 5);
2557

            
2558
    # Array reference
2559
    $dbi->select(where => [3, 5]);
2560

            
2561
In first examle, the following SQL is created.
2562

            
2563
    select * from book where id = ?
2564

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2567
=back
2568

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2571
    $dbi->update(
2572
        table  => 'book',
2573
        param  => {title => 'Perl'},
2574
        where  => {id => 4}
2575
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2576

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2581
=over 4
2582

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2585
Table name.
2586

            
2587
    $dbi->update(table => 'book');
2588

            
2589
=item C<param>
2590

            
2591
Update data. This is hash reference.
2592

            
2593
    $dbi->update(param => {title => 'Perl'});
2594

            
2595
=item C<where>
2596

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2597
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2598
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2599
    
2600
    # Hash reference
2601
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2602
    
2603
    # DBIx::Custom::Where object
2604
    my $where = $dbi->where(
2605
        clause => ['and', '{= author}', '{like title}'],
2606
        param  => {author => 'Ken', title => '%Perl%'}
2607
    );
2608
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2609
    
2610
    # Array refrendce (where clause and parameter)
2611
    $dbi->update(where =>
2612
        [
2613
            ['and', '{= author}', '{like title}'],
2614
            {author => 'Ken', title => '%Perl%'}
2615
        ]
2616
    );
update pod
Yuki Kimoto authored on 2011-03-13
2617

            
2618
=item C<append>
2619

            
2620
Append statement to last of SQL. This is string.
2621

            
2622
    $dbi->update(append => 'order by title');
2623

            
2624
=item C<filter>
2625

            
2626
Filter, executed before data is send to database. This is array reference.
2627
Filter value is code reference or
2628
filter name registerd by C<register_filter()>.
2629

            
2630
    # Basic
2631
    $dbi->update(
2632
        filter => [
2633
            title  => sub { uc $_[0] }
2634
            author => sub { uc $_[0] }
2635
        ]
2636
    );
2637
    
2638
    # At once
2639
    $dbi->update(
2640
        filter => [
2641
            [qw/title author/]  => sub { uc $_[0] }
2642
        ]
2643
    );
2644
    
2645
    # Filter name
2646
    $dbi->update(
2647
        filter => [
2648
            title  => 'upper_case',
2649
            author => 'upper_case'
2650
        ]
2651
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2652

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

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

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

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

            
2662
You can check SQL.
2663

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2666
=back
2667

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

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

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

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

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

            
2679
    $dbi->update_at(
2680
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2681
        primary_key => 'id',
2682
        where => '5',
2683
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2684
    );
2685

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2690
=over 4
2691

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

            
2694
Primary key. This is constant value or array reference.
2695
    
2696
    # Constant value
2697
    $dbi->update(primary_key => 'id');
2698

            
2699
    # Array reference
2700
    $dbi->update(primary_key => ['id1', 'id2' ]);
2701

            
2702
This is used to create where clause.
2703

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

            
2706
Where clause, created from primary key information.
2707
This is constant value or array reference.
2708

            
2709
    # Constant value
2710
    $dbi->update(where => 5);
2711

            
2712
    # Array reference
2713
    $dbi->update(where => [3, 5]);
2714

            
2715
In first examle, the following SQL is created.
2716

            
2717
    update book set title = ? where id = ?
2718

            
2719
Place holders are set to 'Perl' and 5.
2720

            
update pod
Yuki Kimoto authored on 2011-03-13
2721
=back
2722

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

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

            
2727
Create update parameter tag.
2728

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2734
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2735
        {title => 'a', age => 2}
2736
        {no_set => 1}
2737
    );
2738

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2743
    my $where = $dbi->where(
2744
        clause => ['and', '{= title}', '{= author}'],
2745
        param => {title => 'Perl', author => 'Ken'}
2746
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2747

            
2748
Create a new L<DBIx::Custom::Where> object.
2749

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2757
=head1 Tags
2758

            
2759
The following tags is available.
2760

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

            
2763
Table tag
2764

            
2765
    {table TABLE}    ->    TABLE
2766

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2769
=head2 C<?>
2770

            
2771
Placeholder tag.
2772

            
2773
    {? NAME}    ->   ?
2774

            
2775
=head2 C<=>
2776

            
2777
Equal tag.
2778

            
2779
    {= NAME}    ->   NAME = ?
2780

            
2781
=head2 C<E<lt>E<gt>>
2782

            
2783
Not equal tag.
2784

            
2785
    {<> NAME}   ->   NAME <> ?
2786

            
2787
=head2 C<E<lt>>
2788

            
2789
Lower than tag
2790

            
2791
    {< NAME}    ->   NAME < ?
2792

            
2793
=head2 C<E<gt>>
2794

            
2795
Greater than tag
2796

            
2797
    {> NAME}    ->   NAME > ?
2798

            
2799
=head2 C<E<gt>=>
2800

            
2801
Greater than or equal tag
2802

            
2803
    {>= NAME}   ->   NAME >= ?
2804

            
2805
=head2 C<E<lt>=>
2806

            
2807
Lower than or equal tag
2808

            
2809
    {<= NAME}   ->   NAME <= ?
2810

            
2811
=head2 C<like>
2812

            
2813
Like tag
2814

            
2815
    {like NAME}   ->   NAME like ?
2816

            
2817
=head2 C<in>
2818

            
2819
In tag.
2820

            
2821
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2822

            
2823
=head2 C<insert_param>
2824

            
2825
Insert parameter tag.
2826

            
2827
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2828

            
2829
=head2 C<update_param>
2830

            
2831
Updata parameter tag.
2832

            
2833
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2834

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

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

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

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

            
2844
C<< <kimoto.yuki at gmail.com> >>
2845

            
2846
L<http://github.com/yuki-kimoto/DBIx-Custom>
2847

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2848
=head1 AUTHOR
2849

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

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

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

            
2856
This program is free software; you can redistribute it and/or modify it
2857
under the same terms as Perl itself.
2858

            
2859
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2860

            
2861