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

            
cleanup
Yuki Kimoto authored on 2011-04-02
3
our $VERSION = '0.1671';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1073
sub update_at {
1074
    my ($self, %args) = @_;
1075
    
cleanup
Yuki Kimoto authored on 2011-03-09
1076
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1077
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1078
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1079
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1080
    }
1081
    
1082
    # Primary key
1083
    my $primary_keys = delete $args{primary_key};
1084
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1085
    
1086
    # Where clause
1087
    my $where = {};
1088
    my $param = {};
1089
    
1090
    if (exists $args{where}) {
1091
        my $where_columns = delete $args{where};
1092
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1093

            
1094
        croak qq{"where" must be constant value or array reference}
1095
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1096
        
1097
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1098
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1099
        }
1100
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1101
    
1102
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1103
        $param = delete $args{param};
1104
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1105
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1106
        }
1107
    }
1108
    
1109
    return $self->update(where => $where, param => $param, %args);
1110
}
1111

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1112
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1113
    my ($self, $param, $opt) = @_;
1114
    
1115
    # Insert parameter tag
1116
    my @params;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1117
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1118
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1119
    my $q = $self->reserved_word_quote;
1120
    
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1121
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1122
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1123
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1124
        
1125
        my $c = "$q$column$q";
1126
        $c =~ s/\./$q.$q/;
1127
        
1128
        push @params, "$c = {? $c}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1129
    }
1130
    
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1131
    my $clause;
1132
    $clause .= 'set ' unless $opt->{no_set};
1133
    $clause .= join(', ', @params);
1134
    
1135
    return $clause;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1136
}
1137

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

            
1141
    return DBIx::Custom::Where->new(
1142
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1143
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1144
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1145
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1146
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1147
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1148

            
cleanup
Yuki Kimoto authored on 2011-04-02
1149
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1150
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1151
    
cleanup
Yuki Kimoto authored on 2011-01-12
1152
    # bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1153
    my $bind = [];
add tests
yuki-kimoto authored on 2010-08-08
1154
    
removed reconnect method
yuki-kimoto authored on 2010-05-28
1155
    # Build bind values
1156
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1157
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1158
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1159
        
1160
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1161
        my $value;
1162
        if(ref $params->{$column} eq 'ARRAY') {
1163
            my $i = $count->{$column} || 0;
1164
            $i += $not_exists->{$column} || 0;
1165
            my $found;
1166
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1167
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1168
                    $not_exists->{$column}++;
1169
                }
1170
                else  {
1171
                    $value = $params->{$column}->[$k];
1172
                    $found = 1;
1173
                    last
1174
                }
1175
            }
1176
            next unless $found;
1177
        }
1178
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1179
        
cleanup
Yuki Kimoto authored on 2011-01-12
1180
        # Filter
1181
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1182
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1183
        # Type
1184
        push @$bind, {
1185
            value => $f ? $f->($value) : $value,
1186
            type => $type->{$column}
1187
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1188
        
1189
        # Count up 
1190
        $count->{$column}++;
1191
    }
1192
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1193
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1194
}
1195

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1196
sub _connect {
1197
    my $self = shift;
1198
    
1199
    # Attributes
1200
    my $data_source = $self->data_source;
1201
    croak qq{"data_source" must be specified to connect()"}
1202
      unless $data_source;
1203
    my $user        = $self->user;
1204
    my $password    = $self->password;
1205
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1206
    
1207
    # Connect
1208
    my $dbh = eval {DBI->connect(
1209
        $data_source,
1210
        $user,
1211
        $password,
1212
        {
1213
            %{$self->default_dbi_option},
1214
            %$dbi_option
1215
        }
1216
    )};
1217
    
1218
    # Connect error
1219
    croak $@ if $@;
1220
    
1221
    return $dbh;
1222
}
1223

            
cleanup
yuki-kimoto authored on 2010-10-17
1224
sub _croak {
1225
    my ($self, $error, $append) = @_;
1226
    $append ||= "";
1227
    
1228
    # Verbose
1229
    if ($Carp::Verbose) { croak $error }
1230
    
1231
    # Not verbose
1232
    else {
1233
        
1234
        # Remove line and module infromation
1235
        my $at_pos = rindex($error, ' at ');
1236
        $error = substr($error, 0, $at_pos);
1237
        $error =~ s/\s+$//;
1238
        
1239
        croak "$error$append";
1240
    }
1241
}
1242

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1243
sub _need_tables {
1244
    my ($self, $tree, $need_tables, $tables) = @_;
1245
    
1246
    foreach my $table (@$tables) {
1247
        
1248
        if ($tree->{$table}) {
1249
            $need_tables->{$table} = 1;
1250
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1251
        }
1252
    }
1253
}
1254

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1255
sub _push_join {
1256
    my ($self, $sql, $join, $join_tables) = @_;
1257
    
1258
    return unless @$join;
1259
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1260
    my $q = $self->reserved_word_quote;
1261
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1262
    my $tree = {};
1263
    
1264
    for (my $i = 0; $i < @$join; $i++) {
1265
        
1266
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1267
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1268
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1269
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1270
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1271
            
1272
            my $table1 = $1;
1273
            my $table2 = $2;
1274
            
1275
            croak qq{right side table of "$join_clause" must be uniq}
1276
              if exists $tree->{$table2};
1277
            
1278
            $tree->{$table2}
1279
              = {position => $i, parent => $table1, join => $join_clause};
1280
        }
1281
        else {
1282
            croak qq{join "$join_clause" must be two table name};
1283
        }
1284
    }
1285
    
1286
    my $need_tables = {};
1287
    $self->_need_tables($tree, $need_tables, $join_tables);
1288
    
1289
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1290

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1291
    foreach my $need_table (@need_tables) {
1292
        push @$sql, $tree->{$need_table}{join};
1293
    }
1294
}
cleanup
Yuki Kimoto authored on 2011-03-08
1295

            
cleanup
Yuki Kimoto authored on 2011-04-02
1296
sub _remove_duplicate_table {
1297
    my ($self, $tables, $main_table) = @_;
1298
    
1299
    # Remove duplicate table
1300
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1301
    delete $tables{$main_table} if $main_table;
1302
    
1303
    return [keys %tables, $main_table ? $main_table : ()];
1304
}
1305

            
cleanup
Yuki Kimoto authored on 2011-04-02
1306
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1307
    my ($self, $source) = @_;
1308
    
1309
    my $tables = [];
1310
    
1311
    my $safety_character = $self->safety_character;
1312
    my $q = $self->reserved_word_quote;
1313
    my $q_re = quotemeta($q);
1314
    
1315
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1316
                      : qr/\b([$safety_character]+)\./;
1317
    while ($source =~ /$table_re/g) {
1318
        push @$tables, $1;
1319
    }
1320
    
1321
    return $tables;
1322
}
1323

            
cleanup
Yuki Kimoto authored on 2011-04-02
1324
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1325
    my ($self, $where) = @_;
1326
    
1327
    my $w;
1328
    if (ref $where eq 'HASH') {
1329
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1330
        my $q = $self->reserved_word_quote;
1331
        foreach my $column (keys %$where) {
1332
            $column = "$q$column$q";
1333
            $column =~ s/\./$q.$q/;
1334
            push @$clause, "{= $column}" for keys %$where;
1335
        }
1336
        
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1337
        $w = $self->where(clause => $clause, param => $where);
1338
    }
1339
    elsif (ref $where eq 'DBIx::Custom::Where') {
1340
        $w = $where;
1341
    }
1342
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1343
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1344
             "use \$dbi->select(where => \$dbi->where(clause => " .
1345
             "CLAUSE, param => PARAMETER));";
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1346
        $w = $self->where(
1347
            clause => $where->[0],
1348
            param  => $where->[1]
1349
        );
1350
    }
1351
    
1352
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1353
          qq{or array reference, which contains where clause and paramter}
1354
      unless ref $w eq 'DBIx::Custom::Where';
1355
    
1356
    return $w;
1357
}
1358

            
cleanup
Yuki Kimoto authored on 2011-01-25
1359
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1360
__PACKAGE__->attr(
1361
    dbi_options => sub { {} },
1362
    filter_check  => 1
1363
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1364

            
cleanup
Yuki Kimoto authored on 2011-01-25
1365
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1366
sub default_bind_filter {
1367
    my $self = shift;
1368
    
1369
    if (@_) {
1370
        my $fname = $_[0];
1371
        
1372
        if (@_ && !$fname) {
1373
            $self->{default_out_filter} = undef;
1374
        }
1375
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1376
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1377
              unless exists $self->filters->{$fname};
1378
        
1379
            $self->{default_out_filter} = $self->filters->{$fname};
1380
        }
1381
        return $self;
1382
    }
1383
    
1384
    return $self->{default_out_filter};
1385
}
1386

            
cleanup
Yuki Kimoto authored on 2011-01-25
1387
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1388
sub default_fetch_filter {
1389
    my $self = shift;
1390
    
1391
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1392
        my $fname = $_[0];
1393

            
cleanup
Yuki Kimoto authored on 2011-01-12
1394
        if (@_ && !$fname) {
1395
            $self->{default_in_filter} = undef;
1396
        }
1397
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1398
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1399
              unless exists $self->filters->{$fname};
1400
        
1401
            $self->{default_in_filter} = $self->filters->{$fname};
1402
        }
1403
        
1404
        return $self;
1405
    }
1406
    
many changed
Yuki Kimoto authored on 2011-01-23
1407
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1408
}
1409

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1410
# DEPRECATED!
1411
sub insert_param {
1412
    warn "insert_param is renamed to insert_param_tag."
1413
       . " insert_param is DEPRECATED!";
1414
    return shift->insert_param_tag(@_);
1415
}
1416

            
cleanup
Yuki Kimoto authored on 2011-01-25
1417
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1418
sub register_tag_processor {
1419
    return shift->query_builder->register_tag_processor(@_);
1420
}
1421

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1422
# DEPRECATED!
1423
sub update_param {
1424
    warn "update_param is renamed to update_param_tag."
1425
       . " update_param is DEPRECATED!";
1426
    return shift->update_param_tag(@_);
1427
}
cleanup
Yuki Kimoto authored on 2011-03-08
1428
# DEPRECATED!
1429
sub _push_relation {
1430
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1431
    
1432
    if (keys %{$relation || {}}) {
1433
        push @$sql, $need_where ? 'where' : 'and';
1434
        foreach my $rcolumn (keys %$relation) {
1435
            my $table1 = (split (/\./, $rcolumn))[0];
1436
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1437
            push @$tables, ($table1, $table2);
1438
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1439
        }
1440
    }
1441
    pop @$sql if $sql->[-1] eq 'and';    
1442
}
1443

            
1444
# DEPRECATED!
1445
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1446
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1447
    
1448
    if (keys %{$relation || {}}) {
1449
        foreach my $rcolumn (keys %$relation) {
1450
            my $table1 = (split (/\./, $rcolumn))[0];
1451
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1452
            my $table1_exists;
1453
            my $table2_exists;
1454
            foreach my $table (@$tables) {
1455
                $table1_exists = 1 if $table eq $table1;
1456
                $table2_exists = 1 if $table eq $table2;
1457
            }
1458
            unshift @$tables, $table1 unless $table1_exists;
1459
            unshift @$tables, $table2 unless $table2_exists;
1460
        }
1461
    }
1462
}
1463

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1466
=head1 NAME
1467

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

            
1470
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1471

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1472
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1473
    
1474
    # Connect
1475
    my $dbi = DBIx::Custom->connect(
1476
        data_source => "dbi:mysql:database=dbname",
1477
        user => 'ken',
1478
        password => '!LFKD%$&',
1479
        dbi_option => {mysql_enable_utf8 => 1}
1480
    );
cleanup
yuki-kimoto authored on 2010-08-05
1481

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1482
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1483
    $dbi->insert(
1484
        table  => 'book',
1485
        param  => {title => 'Perl', author => 'Ken'}
1486
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1487
    
1488
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1489
    $dbi->update(
1490
        table  => 'book', 
1491
        param  => {title => 'Perl', author => 'Ken'}, 
1492
        where  => {id => 5},
1493
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1494
    
1495
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1496
    $dbi->delete(
1497
        table  => 'book',
1498
        where  => {author => 'Ken'},
1499
    );
cleanup
yuki-kimoto authored on 2010-08-05
1500

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1507
    # Select, more complex
1508
    my $result = $dbi->select(
1509
        table  => 'book',
1510
        column => [
1511
            'book.author as book__author',
1512
            'company.name as company__name'
1513
        ],
1514
        where  => {'book.author' => 'Ken'},
1515
        join => ['left outer join company on book.company_id = company.id'],
1516
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1517
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1518
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1519
    # Fetch
1520
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1521
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1522
    }
1523
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1524
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1525
    while (my $row = $result->fetch_hash) {
1526
        
1527
    }
1528
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1529
    # Execute SQL with parameter.
1530
    $dbi->execute(
1531
        "select id from book where {= author} and {like title}",
1532
        param  => {author => 'ken', title => '%Perl%'}
1533
    );
1534
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1535
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1536

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

            
1539
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1540

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1545
There are many basic methods to execute various queries.
1546
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1547
C<delete_all()>, C<select()>,
1548
C<insert_at()>, C<update_at()>, 
1549
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1550

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1551
=item *
1552

            
1553
Filter when data is send or receive.
1554

            
1555
=item *
1556

            
1557
Data filtering system
1558

            
1559
=item *
1560

            
1561
Model support.
1562

            
1563
=item *
1564

            
1565
Generate where clause dinamically.
1566

            
1567
=item *
1568

            
1569
Generate join clause dinamically.
1570

            
1571
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1572

            
1573
=head1 GUIDE
1574

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

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

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

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

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

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

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

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

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

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

            
1598
=head2 C<default_dbi_option>
1599

            
1600
    my $default_dbi_option = $dbi->default_dbi_option;
1601
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1602

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1606
    {
1607
        RaiseError => 1,
1608
        PrintError => 0,
1609
        AutoCommit => 1,
1610
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1611

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

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

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

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

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

            
1624
    my $models = $dbi->models;
1625
    $dbi       = $dbi->models(\%models);
1626

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1629
=head2 C<password>
1630

            
1631
    my $password = $dbi->password;
1632
    $dbi         = $dbi->password('lkj&le`@s');
1633

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

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

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

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

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

            
1645
     my reserved_word_quote = $dbi->reserved_word_quote;
1646
     $dbi                   = $dbi->reserved_word_quote('"');
1647

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1667
    my $user = $dbi->user;
1668
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1669

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1680
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1681
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1682
        'issue_date' => {
1683
            out => 'tp_to_date',
1684
            in  => 'date_to_tp',
1685
            end => 'tp_to_displaydate'
1686
        },
1687
        'write_date' => {
1688
            out => 'tp_to_date',
1689
            in  => 'date_to_tp',
1690
            end => 'tp_to_displaydate'
1691
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1692
    );
1693

            
update pod
Yuki Kimoto authored on 2011-03-13
1694
Apply filter to columns.
1695
C<out> filter is executed before data is send to database.
1696
C<in> filter is executed after a row is fetch.
1697
C<end> filter is execute after C<in> filter is executed.
1698

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1701
       PETTERN         EXAMPLE
1702
    1. Column        : author
1703
    2. Table.Column  : book.author
1704
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1705

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

            
1709
You can set multiple filters at once.
1710

            
1711
    $dbi->apply_filter(
1712
        'book',
1713
        [qw/issue_date write_date/] => {
1714
            out => 'tp_to_date',
1715
            in  => 'date_to_tp',
1716
            end => 'tp_to_displaydate'
1717
        }
1718
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1719

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1722
    my $dbi = DBIx::Custom->connect(
1723
        data_source => "dbi:mysql:database=dbname",
1724
        user => 'ken',
1725
        password => '!LFKD%$&',
1726
        dbi_option => {mysql_enable_utf8 => 1}
1727
    );
1728

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1737
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1738
        table => 'book',
1739
        primary_key => 'id',
1740
        join => [
1741
            'inner join company on book.comparny_id = company.id'
1742
        ],
1743
        filter => [
1744
            publish_date => {
1745
                out => 'tp_to_date',
1746
                in => 'date_to_tp',
1747
                end => 'tp_to_displaydate'
1748
            }
1749
        ]
1750
    );
1751

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

            
1755
   $dbi->model('book')->select(...);
1756

            
cleanup
yuki-kimoto authored on 2010-10-17
1757
=head2 C<create_query>
1758
    
1759
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1760
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1761
    );
update document
yuki-kimoto authored on 2009-11-19
1762

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

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

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

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

            
1773
    my $dbh = $dbi->dbh;
1774
    $dbi    = $dbi->dbh($dbh);
1775

            
1776
Get and set database handle of L<DBI>.
1777

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

            
1780
=head2 C<each_column>
1781

            
1782
    $dbi->each_column(
1783
        sub {
1784
            my ($dbi, $table, $column, $column_info) = @_;
1785
            
1786
            my $type = $column_info->{TYPE_NAME};
1787
            
1788
            if ($type eq 'DATE') {
1789
                # ...
1790
            }
1791
        }
1792
    );
1793

            
1794
Iterate all column informations of all table from database.
1795
Argument is callback when one column is found.
1796
Callback receive four arguments, dbi object, table name,
1797
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1798

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1801
    my $result = $dbi->execute(
1802
        "select * from book where {= title} and {like author}",
1803
        param => {title => 'Perl', author => '%Ken%'}
1804
    );
1805

            
1806
Execute SQL, containing tags.
1807
Return value is L<DBIx::Custom::Result> in select statement, or
1808
the count of affected rows in insert, update, delete statement.
1809

            
1810
Tag is turned into the statement containing place holder
1811
before SQL is executed.
1812

            
1813
    select * from where title = ? and author like ?;
1814

            
1815
See also L<Tags/Tags>.
1816

            
1817
The following opitons are currently available.
1818

            
1819
=over 4
1820

            
1821
=item C<filter>
1822

            
1823
Filter, executed before data is send to database. This is array reference.
1824
Filter value is code reference or
1825
filter name registerd by C<register_filter()>.
1826

            
1827
    # Basic
1828
    $dbi->execute(
1829
        $sql,
1830
        filter => [
1831
            title  => sub { uc $_[0] }
1832
            author => sub { uc $_[0] }
1833
        ]
1834
    );
1835
    
1836
    # At once
1837
    $dbi->execute(
1838
        $sql,
1839
        filter => [
1840
            [qw/title author/]  => sub { uc $_[0] }
1841
        ]
1842
    );
1843
    
1844
    # Filter name
1845
    $dbi->execute(
1846
        $sql,
1847
        filter => [
1848
            title  => 'upper_case',
1849
            author => 'upper_case'
1850
        ]
1851
    );
1852

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

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

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

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

            
1861
Delete statement.
1862

            
1863
The following opitons are currently available.
1864

            
update pod
Yuki Kimoto authored on 2011-03-13
1865
=over 4
1866

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

            
1869
Table name.
1870

            
1871
    $dbi->delete(table => 'book');
1872

            
1873
=item C<where>
1874

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1875
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1876
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1877
    
1878
    # Hash reference
1879
    $dbi->delete(where => {title => 'Perl'});
1880
    
1881
    # DBIx::Custom::Where object
1882
    my $where = $dbi->where(
1883
        clause => ['and', '{= author}', '{like title}'],
1884
        param  => {author => 'Ken', title => '%Perl%'}
1885
    );
1886
    $dbi->delete(where => $where);
1887

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1888
    # Array refrendce (where clause and parameter)
1889
    $dbi->delete(where =>
1890
        [
1891
            ['and', '{= author}', '{like title}'],
1892
            {author => 'Ken', title => '%Perl%'}
1893
        ]
1894
    );
1895
    
update pod
Yuki Kimoto authored on 2011-03-13
1896
=item C<append>
1897

            
1898
Append statement to last of SQL. This is string.
1899

            
1900
    $dbi->delete(append => 'order by title');
1901

            
1902
=item C<filter>
1903

            
1904
Filter, executed before data is send to database. This is array reference.
1905
Filter value is code reference or
1906
filter name registerd by C<register_filter()>.
1907

            
1908
    # Basic
1909
    $dbi->delete(
1910
        filter => [
1911
            title  => sub { uc $_[0] }
1912
            author => sub { uc $_[0] }
1913
        ]
1914
    );
1915
    
1916
    # At once
1917
    $dbi->delete(
1918
        filter => [
1919
            [qw/title author/]  => sub { uc $_[0] }
1920
        ]
1921
    );
1922
    
1923
    # Filter name
1924
    $dbi->delete(
1925
        filter => [
1926
            title  => 'upper_case',
1927
            author => 'upper_case'
1928
        ]
1929
    );
1930

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

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

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

            
1937
Create column clause. The follwoing column clause is created.
1938

            
1939
    book.author as book__author,
1940
    book.title as book__title
1941

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

            
1944
Get L<DBIx::Custom::Query> object instead of executing SQL.
1945
This is true or false value.
1946

            
1947
    my $query = $dbi->delete(query => 1);
1948

            
1949
You can check SQL.
1950

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1953
=back
1954

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

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

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

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

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

            
1966
    $dbi->delete_at(
1967
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1968
        primary_key => 'id',
1969
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1970
    );
1971

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1976
=over 4
1977

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1980
Primary key. This is constant value or array reference.
1981
    
1982
    # Constant value
1983
    $dbi->delete(primary_key => 'id');
1984

            
1985
    # Array reference
1986
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1987

            
1988
This is used to create where clause.
1989

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

            
1992
Where clause, created from primary key information.
1993
This is constant value or array reference.
1994

            
1995
    # Constant value
1996
    $dbi->delete(where => 5);
1997

            
1998
    # Array reference
1999
    $dbi->delete(where => [3, 5]);
2000

            
2001
In first examle, the following SQL is created.
2002

            
2003
    delete from book where id = ?;
2004

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2007
=back
2008

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2011
    $dbi->insert(
2012
        table  => 'book', 
2013
        param  => {title => 'Perl', author => 'Ken'}
2014
    );
2015

            
2016
Insert statement.
2017

            
2018
The following opitons are currently available.
2019

            
update pod
Yuki Kimoto authored on 2011-03-13
2020
=over 4
2021

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

            
2024
Table name.
2025

            
2026
    $dbi->insert(table => 'book');
2027

            
2028
=item C<param>
2029

            
2030
Insert data. This is hash reference.
2031

            
2032
    $dbi->insert(param => {title => 'Perl'});
2033

            
2034
=item C<append>
2035

            
2036
Append statement to last of SQL. This is string.
2037

            
2038
    $dbi->insert(append => 'order by title');
2039

            
2040
=item C<filter>
2041

            
2042
Filter, executed before data is send to database. This is array reference.
2043
Filter value is code reference or
2044
filter name registerd by C<register_filter()>.
2045

            
2046
    # Basic
2047
    $dbi->insert(
2048
        filter => [
2049
            title  => sub { uc $_[0] }
2050
            author => sub { uc $_[0] }
2051
        ]
2052
    );
2053
    
2054
    # At once
2055
    $dbi->insert(
2056
        filter => [
2057
            [qw/title author/]  => sub { uc $_[0] }
2058
        ]
2059
    );
2060
    
2061
    # Filter name
2062
    $dbi->insert(
2063
        filter => [
2064
            title  => 'upper_case',
2065
            author => 'upper_case'
2066
        ]
2067
    );
2068

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

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

            
2073
Get L<DBIx::Custom::Query> object instead of executing SQL.
2074
This is true or false value.
2075

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2082
=back
2083

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

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

            
2088
    $dbi->insert_at(
2089
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2090
        primary_key => 'id',
2091
        where => '5',
2092
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2093
    );
2094

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2099
=over 4
2100

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

            
2103
Primary key. This is constant value or array reference.
2104
    
2105
    # Constant value
2106
    $dbi->insert(primary_key => 'id');
2107

            
2108
    # Array reference
2109
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2110

            
2111
This is used to create parts of insert data.
2112

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

            
2115
Parts of Insert data, create from primary key information.
2116
This is constant value or array reference.
2117

            
2118
    # Constant value
2119
    $dbi->insert(where => 5);
2120

            
2121
    # Array reference
2122
    $dbi->insert(where => [3, 5]);
2123

            
2124
In first examle, the following SQL is created.
2125

            
2126
    insert into book (id, title) values (?, ?);
2127

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2130
=back
2131

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

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

            
2136
Create insert parameter tag.
2137

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2147
    lib / MyModel.pm
2148
        / MyModel / book.pm
2149
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2150

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

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

            
2155
    package MyModel;
2156
    
2157
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2158
    
2159
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2160

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2165
    package MyModel::book;
2166
    
2167
    use base 'MyModel';
2168
    
2169
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2170

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2173
    package MyModel::company;
2174
    
2175
    use base 'MyModel';
2176
    
2177
    1;
2178
    
2179
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2180

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

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

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

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

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

            
2192
Merge paramters.
2193

            
2194
$param:
2195

            
2196
    {key1 => [1, 1], key2 => 2}
2197

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

            
2200
    $dbi->method(
2201
        update_or_insert => sub {
2202
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2203
            
2204
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2205
        },
2206
        find_or_create   => sub {
2207
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2208
            
2209
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2210
        }
2211
    );
2212

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

            
2215
    $dbi->update_or_insert;
2216
    $dbi->find_or_create;
2217

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

            
2220
    $dbi->model('book')->method(
2221
        insert => sub { ... },
2222
        update => sub { ... }
2223
    );
2224
    
2225
    my $model = $dbi->model('book');
2226

            
2227
Set and get a L<DBIx::Custom::Model> object,
2228

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

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

            
2233
Create column clause for myself. The follwoing column clause is created.
2234

            
2235
    book.author as author,
2236
    book.title as title
2237

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2240
    my $dbi = DBIx::Custom->new(
2241
        data_source => "dbi:mysql:database=dbname",
2242
        user => 'ken',
2243
        password => '!LFKD%$&',
2244
        dbi_option => {mysql_enable_utf8 => 1}
2245
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2246

            
2247
Create a new L<DBIx::Custom> object.
2248

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

            
2251
    my $not_exists = $dbi->not_exists;
2252

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2256
=head2 C<register_filter>
2257

            
update pod
Yuki Kimoto authored on 2011-03-13
2258
    $dbi->register_filter(
2259
        # Time::Piece object to database DATE format
2260
        tp_to_date => sub {
2261
            my $tp = shift;
2262
            return $tp->strftime('%Y-%m-%d');
2263
        },
2264
        # database DATE format to Time::Piece object
2265
        date_to_tp => sub {
2266
           my $date = shift;
2267
           return Time::Piece->strptime($date, '%Y-%m-%d');
2268
        }
2269
    );
cleanup
yuki-kimoto authored on 2010-10-17
2270
    
update pod
Yuki Kimoto authored on 2011-03-13
2271
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2272

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2275
    $dbi->register_tag(
2276
        update => sub {
2277
            my @columns = @_;
2278
            
2279
            # Update parameters
2280
            my $s = 'set ';
2281
            $s .= "$_ = ?, " for @columns;
2282
            $s =~ s/, $//;
2283
            
2284
            return [$s, \@columns];
2285
        }
2286
    );
cleanup
yuki-kimoto authored on 2010-10-17
2287

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2309
=head2 C<replace> EXPERIMENTAL
2310
    
2311
    my $join = [
2312
        'left outer join table2 on table1.key1 = table2.key1',
2313
        'left outer join table3 on table2.key3 = table3.key3'
2314
    ];
2315
    $join = $dbi->replace(
2316
        $join,
2317
        'left outer join table2 on table1.key1 = table2.key1',
2318
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2319
          'as table2 on table1.key1 = table2.key1'
2320
    );
2321

            
2322
Replace join clauses if match the expression.
2323

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2326
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2327
        table  => 'book',
2328
        column => ['author', 'title'],
2329
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2330
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2331
    
update pod
Yuki Kimoto authored on 2011-03-12
2332
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2333

            
2334
The following opitons are currently available.
2335

            
2336
=over 4
2337

            
2338
=item C<table>
2339

            
2340
Table name.
2341

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

            
2344
=item C<column>
2345

            
2346
Column clause. This is array reference or constant value.
2347

            
2348
    # Hash refernce
2349
    $dbi->select(column => ['author', 'title']);
2350
    
2351
    # Constant value
2352
    $dbi->select(column => 'author');
2353

            
2354
Default is '*' unless C<column> is specified.
2355

            
2356
    # Default
2357
    $dbi->select(column => '*');
2358

            
2359
=item C<where>
2360

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2361
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2362
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2363
    
2364
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2365
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2366
    
update pod
Yuki Kimoto authored on 2011-03-12
2367
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2368
    my $where = $dbi->where(
2369
        clause => ['and', '{= author}', '{like title}'],
2370
        param  => {author => 'Ken', title => '%Perl%'}
2371
    );
update pod
Yuki Kimoto authored on 2011-03-12
2372
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2373

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2374
    # Array refrendce (where clause and parameter)
2375
    $dbi->select(where =>
2376
        [
2377
            ['and', '{= author}', '{like title}'],
2378
            {author => 'Ken', title => '%Perl%'}
2379
        ]
2380
    );
2381
    
update pod
Yuki Kimoto authored on 2011-03-13
2382
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2383

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

            
2386
    $dbi->select(join =>
2387
        [
2388
            'left outer join company on book.company_id = company_id',
2389
            'left outer join location on company.location_id = location.id'
2390
        ]
2391
    );
2392

            
2393
If column cluase or where clause contain table name like "company.name",
2394
needed join clause is used automatically.
2395

            
2396
    $dbi->select(
2397
        table => 'book',
2398
        column => ['company.location_id as company__location_id'],
2399
        where => {'company.name' => 'Orange'},
2400
        join => [
2401
            'left outer join company on book.company_id = company.id',
2402
            'left outer join location on company.location_id = location.id'
2403
        ]
2404
    );
2405

            
2406
In above select, the following SQL is created.
2407

            
2408
    select company.location_id as company__location_id
2409
    from book
2410
      left outer join company on book.company_id = company.id
2411
    where company.name = Orange
2412

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

            
2415
Parameter shown before where clause.
2416
    
2417
    $dbi->select(
2418
        table => 'table1',
2419
        column => 'table1.key1 as table1_key1, key2, key3',
2420
        where   => {'table1.key2' => 3},
2421
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2422
                  ' as table2 on table1.key1 = table2.key1'],
2423
        param => {'table2.key3' => 5}
2424
    );
2425

            
2426
For example, if you want to contain tag in join clause, 
2427
you can pass parameter by C<param> option.
2428

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

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

            
2433
    $dbi->select(append => 'order by title');
2434

            
2435
=item C<filter>
2436

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

            
2441
    # Basic
2442
    $dbi->select(
2443
        filter => [
2444
            title  => sub { uc $_[0] }
2445
            author => sub { uc $_[0] }
2446
        ]
2447
    );
2448
    
2449
    # At once
2450
    $dbi->select(
2451
        filter => [
2452
            [qw/title author/]  => sub { uc $_[0] }
2453
        ]
2454
    );
2455
    
2456
    # Filter name
2457
    $dbi->select(
2458
        filter => [
2459
            title  => 'upper_case',
2460
            author => 'upper_case'
2461
        ]
2462
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2463

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

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

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

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

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

            
2475
    my $sql = $query->sql;
2476

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

            
2479
Specify database data type.
2480

            
2481
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2482
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2483

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

            
2486
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2487

            
update pod
Yuki Kimoto authored on 2011-03-12
2488
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2489

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

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

            
2494
    $dbi->select_at(
2495
        table => 'book',
2496
        primary_key => 'id',
2497
        where => '5'
2498
    );
2499

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2504
=over 4
2505

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2508
Primary key. This is constant value or array reference.
2509
    
2510
    # Constant value
2511
    $dbi->select(primary_key => 'id');
2512

            
2513
    # Array reference
2514
    $dbi->select(primary_key => ['id1', 'id2' ]);
2515

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

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

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

            
2523
    # Constant value
2524
    $dbi->select(where => 5);
2525

            
2526
    # Array reference
2527
    $dbi->select(where => [3, 5]);
2528

            
2529
In first examle, the following SQL is created.
2530

            
2531
    select * from book where id = ?
2532

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2535
=back
2536

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2539
    $dbi->update(
2540
        table  => 'book',
2541
        param  => {title => 'Perl'},
2542
        where  => {id => 4}
2543
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2544

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2549
=over 4
2550

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2553
Table name.
2554

            
2555
    $dbi->update(table => 'book');
2556

            
2557
=item C<param>
2558

            
2559
Update data. This is hash reference.
2560

            
2561
    $dbi->update(param => {title => 'Perl'});
2562

            
2563
=item C<where>
2564

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2565
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2566
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2567
    
2568
    # Hash reference
2569
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2570
    
2571
    # DBIx::Custom::Where object
2572
    my $where = $dbi->where(
2573
        clause => ['and', '{= author}', '{like title}'],
2574
        param  => {author => 'Ken', title => '%Perl%'}
2575
    );
2576
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2577
    
2578
    # Array refrendce (where clause and parameter)
2579
    $dbi->update(where =>
2580
        [
2581
            ['and', '{= author}', '{like title}'],
2582
            {author => 'Ken', title => '%Perl%'}
2583
        ]
2584
    );
update pod
Yuki Kimoto authored on 2011-03-13
2585

            
2586
=item C<append>
2587

            
2588
Append statement to last of SQL. This is string.
2589

            
2590
    $dbi->update(append => 'order by title');
2591

            
2592
=item C<filter>
2593

            
2594
Filter, executed before data is send to database. This is array reference.
2595
Filter value is code reference or
2596
filter name registerd by C<register_filter()>.
2597

            
2598
    # Basic
2599
    $dbi->update(
2600
        filter => [
2601
            title  => sub { uc $_[0] }
2602
            author => sub { uc $_[0] }
2603
        ]
2604
    );
2605
    
2606
    # At once
2607
    $dbi->update(
2608
        filter => [
2609
            [qw/title author/]  => sub { uc $_[0] }
2610
        ]
2611
    );
2612
    
2613
    # Filter name
2614
    $dbi->update(
2615
        filter => [
2616
            title  => 'upper_case',
2617
            author => 'upper_case'
2618
        ]
2619
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2620

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

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

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

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

            
2630
You can check SQL.
2631

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2634
=back
2635

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

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

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

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

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

            
2647
    $dbi->update_at(
2648
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2649
        primary_key => 'id',
2650
        where => '5',
2651
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2652
    );
2653

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2658
=over 4
2659

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

            
2662
Primary key. This is constant value or array reference.
2663
    
2664
    # Constant value
2665
    $dbi->update(primary_key => 'id');
2666

            
2667
    # Array reference
2668
    $dbi->update(primary_key => ['id1', 'id2' ]);
2669

            
2670
This is used to create where clause.
2671

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

            
2674
Where clause, created from primary key information.
2675
This is constant value or array reference.
2676

            
2677
    # Constant value
2678
    $dbi->update(where => 5);
2679

            
2680
    # Array reference
2681
    $dbi->update(where => [3, 5]);
2682

            
2683
In first examle, the following SQL is created.
2684

            
2685
    update book set title = ? where id = ?
2686

            
2687
Place holders are set to 'Perl' and 5.
2688

            
update pod
Yuki Kimoto authored on 2011-03-13
2689
=back
2690

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

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

            
2695
Create update parameter tag.
2696

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2702
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2703
        {title => 'a', age => 2}
2704
        {no_set => 1}
2705
    );
2706

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2711
    my $where = $dbi->where(
2712
        clause => ['and', '{= title}', '{= author}'],
2713
        param => {title => 'Perl', author => 'Ken'}
2714
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2715

            
2716
Create a new L<DBIx::Custom::Where> object.
2717

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2725
=head1 Tags
2726

            
2727
The following tags is available.
2728

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

            
2731
Table tag
2732

            
2733
    {table TABLE}    ->    TABLE
2734

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2737
=head2 C<?>
2738

            
2739
Placeholder tag.
2740

            
2741
    {? NAME}    ->   ?
2742

            
2743
=head2 C<=>
2744

            
2745
Equal tag.
2746

            
2747
    {= NAME}    ->   NAME = ?
2748

            
2749
=head2 C<E<lt>E<gt>>
2750

            
2751
Not equal tag.
2752

            
2753
    {<> NAME}   ->   NAME <> ?
2754

            
2755
=head2 C<E<lt>>
2756

            
2757
Lower than tag
2758

            
2759
    {< NAME}    ->   NAME < ?
2760

            
2761
=head2 C<E<gt>>
2762

            
2763
Greater than tag
2764

            
2765
    {> NAME}    ->   NAME > ?
2766

            
2767
=head2 C<E<gt>=>
2768

            
2769
Greater than or equal tag
2770

            
2771
    {>= NAME}   ->   NAME >= ?
2772

            
2773
=head2 C<E<lt>=>
2774

            
2775
Lower than or equal tag
2776

            
2777
    {<= NAME}   ->   NAME <= ?
2778

            
2779
=head2 C<like>
2780

            
2781
Like tag
2782

            
2783
    {like NAME}   ->   NAME like ?
2784

            
2785
=head2 C<in>
2786

            
2787
In tag.
2788

            
2789
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2790

            
2791
=head2 C<insert_param>
2792

            
2793
Insert parameter tag.
2794

            
2795
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2796

            
2797
=head2 C<update_param>
2798

            
2799
Updata parameter tag.
2800

            
2801
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2802

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

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

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

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

            
2812
C<< <kimoto.yuki at gmail.com> >>
2813

            
2814
L<http://github.com/yuki-kimoto/DBIx-Custom>
2815

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2816
=head1 AUTHOR
2817

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

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

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

            
2824
This program is free software; you can redistribute it and/or modify it
2825
under the same terms as Perl itself.
2826

            
2827
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2828

            
2829