DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2864 lines | 68.767kb
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
410
    my $params = delete $args{param} || {};
411
    my $tables = delete $args{table} || [];
412
    $tables = [$tables] unless ref $tables eq 'ARRAY';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
413
    
cleanup
Yuki Kimoto authored on 2011-03-09
414
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
415
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
416
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
417
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
418
    }
419
    
cleanup
Yuki Kimoto authored on 2011-04-02
420
    # Create query
421
    $query = $self->create_query($query) unless ref $query;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
422
    
cleanup
Yuki Kimoto authored on 2011-04-02
423
    # Tables
424
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
425
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
426
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
427
    $tables = $self->_remove_duplicate_table($tables, $main_table);
428
    if (my $q = $self->reserved_word_quote) {
429
        $_ =~ s/$q//g for @$tables;
430
    }
cleanup
Yuki Kimoto authored on 2011-04-02
431
    
432
    # Table alias
cleanup
Yuki Kimoto authored on 2011-04-02
433
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
434
        
cleanup
Yuki Kimoto authored on 2011-04-02
435
        # No need
436
        next unless my $alias = $self->{_table_alias}->{$table};
437
        $self->{filter} ||= {};
438
        next if $self->{filter}{out}{$table};
439
        
440
        # Filter
441
        $self->{filter}{out} ||= {};
442
        $self->{filter}{in}  ||= {};
443
        $self->{filter}{end} ||= {};
444
        
445
        # Create alias filter
446
        foreach my $type (qw/out in end/) {
447
            my @filter_names = keys %{$self->{filter}{$type}{$alias} || {}};
448
            foreach my $filter_name (@filter_names) {
449
                my $filter_name_alias = $filter_name;
450
                $filter_name_alias =~ s/^$alias\./$table\./;
451
                $filter_name_alias =~ s/^${alias}__/${table}__/; 
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
452
                
cleanup
Yuki Kimoto authored on 2011-04-02
453
                $self->{filter}{$type}{$table}{$filter_name_alias}
454
                  = $self->{filter}{$type}{$alias}{$filter_name}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
455
            }
456
        }
457
    }
cleanup
Yuki Kimoto authored on 2011-04-02
458

            
459
    # Filters
460
    my $filter = {};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
461
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
462
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
463
        $filter = {
464
            %$filter,
465
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
466
        }
467
    }
468
    
cleanup
Yuki Kimoto authored on 2011-01-12
469
    # Filter argument
cleanup
Yuki Kimoto authored on 2011-03-21
470
    my $f = DBIx::Custom::Util::array_to_hash($args{filter})
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
471
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
472
    foreach my $column (keys %$f) {
473
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
474
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
475
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
476
        }
477
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
478
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
479
            unless exists $self->filters->{$fname};
480
          
cleanup
Yuki Kimoto authored on 2011-01-12
481
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
482
        }
483
    }
cleanup
Yuki Kimoto authored on 2011-01-12
484
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
485
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
486
    # Type
487
    my $type = DBIx::Custom::Util::array_to_hash($args{type});
488
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
489
    # Bind
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
490
    my $bind = $self->_bind($params, $query->columns, $filter, $type);
cleanup
yuki-kimoto authored on 2010-10-17
491
    
492
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
493
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
494
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
495
    eval {
496
        for (my $i = 0; $i < @$bind; $i++) {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
497
            if (my $type = $bind->[$i]->{type}) {
498
                $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);
499
            }
500
            else {
501
                $sth->bind_param($i + 1, $bind->[$i]->{value});
502
            }
cleanup
Yuki Kimoto authored on 2011-03-21
503
        }
504
        $affected = $sth->execute;
505
    };
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
506
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
cleanup
yuki-kimoto authored on 2010-10-17
507
    
508
    # Return resultset if select statement is executed
509
    if ($sth->{NUM_OF_FIELDS}) {
510
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
511
        # Result in and end filter
512
        my $in_filter  = {};
513
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
514
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
515
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
516
            $in_filter = {
517
                %$in_filter,
518
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
519
            };
520
            $end_filter = {
521
                %$end_filter,
522
                %{$self->{filter}{end}{$table} || {}}
523
            };
cleanup
Yuki Kimoto authored on 2011-01-12
524
        }
525
        
526
        # Result
527
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
528
            sth            => $sth,
529
            filters        => $self->filters,
530
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
531
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
532
            filter         => $in_filter || {},
533
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
534
        );
535

            
536
        return $result;
537
    }
538
    return $affected;
539
}
540

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

            
cleanup
yuki-kimoto authored on 2010-10-17
543
sub insert {
544
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
545
    
cleanup
Yuki Kimoto authored on 2011-04-02
546
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
547
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
548

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1501
=head1 NAME
1502

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

            
1505
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1506

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

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

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

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

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

            
1574
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1575

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1586
=item *
1587

            
1588
Filter when data is send or receive.
1589

            
1590
=item *
1591

            
1592
Data filtering system
1593

            
1594
=item *
1595

            
1596
Model support.
1597

            
1598
=item *
1599

            
1600
Generate where clause dinamically.
1601

            
1602
=item *
1603

            
1604
Generate join clause dinamically.
1605

            
1606
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1607

            
1608
=head1 GUIDE
1609

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

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

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

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

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

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

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

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

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

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

            
1633
=head2 C<default_dbi_option>
1634

            
1635
    my $default_dbi_option = $dbi->default_dbi_option;
1636
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1637

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

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

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

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

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

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

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

            
1659
    my $models = $dbi->models;
1660
    $dbi       = $dbi->models(\%models);
1661

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1664
=head2 C<password>
1665

            
1666
    my $password = $dbi->password;
1667
    $dbi         = $dbi->password('lkj&le`@s');
1668

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

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

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

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

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

            
1680
     my reserved_word_quote = $dbi->reserved_word_quote;
1681
     $dbi                   = $dbi->reserved_word_quote('"');
1682

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1702
    my $user = $dbi->user;
1703
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1704

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

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

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

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

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

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

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

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

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

            
1744
You can set multiple filters at once.
1745

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

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

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

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

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

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

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

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

            
1790
   $dbi->model('book')->select(...);
1791

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

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

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

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

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

            
1808
    my $dbh = $dbi->dbh;
1809
    $dbi    = $dbi->dbh($dbh);
1810

            
1811
Get and set database handle of L<DBI>.
1812

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

            
1815
=head2 C<each_column>
1816

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

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

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

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

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

            
1845
Tag is turned into the statement containing place holder
1846
before SQL is executed.
1847

            
1848
    select * from where title = ? and author like ?;
1849

            
1850
See also L<Tags/Tags>.
1851

            
1852
The following opitons are currently available.
1853

            
1854
=over 4
1855

            
1856
=item C<filter>
1857

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

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

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

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

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

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

            
1896
Delete statement.
1897

            
1898
The following opitons are currently available.
1899

            
update pod
Yuki Kimoto authored on 2011-03-13
1900
=over 4
1901

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

            
1904
Table name.
1905

            
1906
    $dbi->delete(table => 'book');
1907

            
1908
=item C<where>
1909

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

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

            
1933
Append statement to last of SQL. This is string.
1934

            
1935
    $dbi->delete(append => 'order by title');
1936

            
1937
=item C<filter>
1938

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

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

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

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

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

            
1972
Create column clause. The follwoing column clause is created.
1973

            
1974
    book.author as book__author,
1975
    book.title as book__title
1976

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

            
1979
Get L<DBIx::Custom::Query> object instead of executing SQL.
1980
This is true or false value.
1981

            
1982
    my $query = $dbi->delete(query => 1);
1983

            
1984
You can check SQL.
1985

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

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

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

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

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

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

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

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

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

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

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

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

            
2020
    # Array reference
2021
    $dbi->delete(primary_key => ['id1', 'id2' ]);
2022

            
2023
This is used to create where clause.
2024

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

            
2027
Where clause, created from primary key information.
2028
This is constant value or array reference.
2029

            
2030
    # Constant value
2031
    $dbi->delete(where => 5);
2032

            
2033
    # Array reference
2034
    $dbi->delete(where => [3, 5]);
2035

            
2036
In first examle, the following SQL is created.
2037

            
2038
    delete from book where id = ?;
2039

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2042
=back
2043

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

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

            
2051
Insert statement.
2052

            
2053
The following opitons are currently available.
2054

            
update pod
Yuki Kimoto authored on 2011-03-13
2055
=over 4
2056

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

            
2059
Table name.
2060

            
2061
    $dbi->insert(table => 'book');
2062

            
2063
=item C<param>
2064

            
2065
Insert data. This is hash reference.
2066

            
2067
    $dbi->insert(param => {title => 'Perl'});
2068

            
2069
=item C<append>
2070

            
2071
Append statement to last of SQL. This is string.
2072

            
2073
    $dbi->insert(append => 'order by title');
2074

            
2075
=item C<filter>
2076

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

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

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

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

            
2108
Get L<DBIx::Custom::Query> object instead of executing SQL.
2109
This is true or false value.
2110

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2117
=back
2118

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2134
=over 4
2135

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

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

            
2143
    # Array reference
2144
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2145

            
2146
This is used to create parts of insert data.
2147

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

            
2150
Parts of Insert data, create from primary key information.
2151
This is constant value or array reference.
2152

            
2153
    # Constant value
2154
    $dbi->insert(where => 5);
2155

            
2156
    # Array reference
2157
    $dbi->insert(where => [3, 5]);
2158

            
2159
In first examle, the following SQL is created.
2160

            
2161
    insert into book (id, title) values (?, ?);
2162

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2165
=back
2166

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

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

            
2171
Create insert parameter tag.
2172

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2227
Merge paramters.
2228

            
2229
$param:
2230

            
2231
    {key1 => [1, 1], key2 => 2}
2232

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

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

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

            
2250
    $dbi->update_or_insert;
2251
    $dbi->find_or_create;
2252

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

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

            
2262
Set and get a L<DBIx::Custom::Model> object,
2263

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

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

            
2268
Create column clause for myself. The follwoing column clause is created.
2269

            
2270
    book.author as author,
2271
    book.title as title
2272

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

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

            
2282
Create a new L<DBIx::Custom> object.
2283

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

            
2286
    my $not_exists = $dbi->not_exists;
2287

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2291
=head2 C<register_filter>
2292

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2357
Replace join clauses if match the expression.
2358

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

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

            
2369
The following opitons are currently available.
2370

            
2371
=over 4
2372

            
2373
=item C<table>
2374

            
2375
Table name.
2376

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

            
2379
=item C<column>
2380

            
2381
Column clause. This is array reference or constant value.
2382

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

            
2389
Default is '*' unless C<column> is specified.
2390

            
2391
    # Default
2392
    $dbi->select(column => '*');
2393

            
2394
=item C<where>
2395

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

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

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

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

            
2428
If column cluase or where clause contain table name like "company.name",
2429
needed join clause is used automatically.
2430

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

            
2441
In above select, the following SQL is created.
2442

            
2443
    select company.location_id as company__location_id
2444
    from book
2445
      left outer join company on book.company_id = company.id
2446
    where company.name = Orange
2447

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

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

            
2461
For example, if you want to contain tag in join clause, 
2462
you can pass parameter by C<param> option.
2463

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

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

            
2468
    $dbi->select(append => 'order by title');
2469

            
2470
=item C<filter>
2471

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

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

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

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

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

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

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

            
2510
    my $sql = $query->sql;
2511

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

            
2514
Specify database data type.
2515

            
2516
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2517
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2518

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

            
2521
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2522

            
update pod
Yuki Kimoto authored on 2011-03-12
2523
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2524

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

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

            
2529
    $dbi->select_at(
2530
        table => 'book',
2531
        primary_key => 'id',
2532
        where => '5'
2533
    );
2534

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2539
=over 4
2540

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

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

            
2548
    # Array reference
2549
    $dbi->select(primary_key => ['id1', 'id2' ]);
2550

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

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

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

            
2558
    # Constant value
2559
    $dbi->select(where => 5);
2560

            
2561
    # Array reference
2562
    $dbi->select(where => [3, 5]);
2563

            
2564
In first examle, the following SQL is created.
2565

            
2566
    select * from book where id = ?
2567

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2570
=back
2571

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2584
=over 4
2585

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2588
Table name.
2589

            
2590
    $dbi->update(table => 'book');
2591

            
2592
=item C<param>
2593

            
2594
Update data. This is hash reference.
2595

            
2596
    $dbi->update(param => {title => 'Perl'});
2597

            
2598
=item C<where>
2599

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

            
2621
=item C<append>
2622

            
2623
Append statement to last of SQL. This is string.
2624

            
2625
    $dbi->update(append => 'order by title');
2626

            
2627
=item C<filter>
2628

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

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

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

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

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

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

            
2665
You can check SQL.
2666

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

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2693
=over 4
2694

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

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

            
2702
    # Array reference
2703
    $dbi->update(primary_key => ['id1', 'id2' ]);
2704

            
2705
This is used to create where clause.
2706

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

            
2709
Where clause, created from primary key information.
2710
This is constant value or array reference.
2711

            
2712
    # Constant value
2713
    $dbi->update(where => 5);
2714

            
2715
    # Array reference
2716
    $dbi->update(where => [3, 5]);
2717

            
2718
In first examle, the following SQL is created.
2719

            
2720
    update book set title = ? where id = ?
2721

            
2722
Place holders are set to 'Perl' and 5.
2723

            
update pod
Yuki Kimoto authored on 2011-03-13
2724
=back
2725

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

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

            
2730
Create update parameter tag.
2731

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

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

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

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

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

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

            
2751
Create a new L<DBIx::Custom::Where> object.
2752

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2760
=head1 Tags
2761

            
2762
The following tags is available.
2763

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

            
2766
Table tag
2767

            
2768
    {table TABLE}    ->    TABLE
2769

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2772
=head2 C<?>
2773

            
2774
Placeholder tag.
2775

            
2776
    {? NAME}    ->   ?
2777

            
2778
=head2 C<=>
2779

            
2780
Equal tag.
2781

            
2782
    {= NAME}    ->   NAME = ?
2783

            
2784
=head2 C<E<lt>E<gt>>
2785

            
2786
Not equal tag.
2787

            
2788
    {<> NAME}   ->   NAME <> ?
2789

            
2790
=head2 C<E<lt>>
2791

            
2792
Lower than tag
2793

            
2794
    {< NAME}    ->   NAME < ?
2795

            
2796
=head2 C<E<gt>>
2797

            
2798
Greater than tag
2799

            
2800
    {> NAME}    ->   NAME > ?
2801

            
2802
=head2 C<E<gt>=>
2803

            
2804
Greater than or equal tag
2805

            
2806
    {>= NAME}   ->   NAME >= ?
2807

            
2808
=head2 C<E<lt>=>
2809

            
2810
Lower than or equal tag
2811

            
2812
    {<= NAME}   ->   NAME <= ?
2813

            
2814
=head2 C<like>
2815

            
2816
Like tag
2817

            
2818
    {like NAME}   ->   NAME like ?
2819

            
2820
=head2 C<in>
2821

            
2822
In tag.
2823

            
2824
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2825

            
2826
=head2 C<insert_param>
2827

            
2828
Insert parameter tag.
2829

            
2830
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2831

            
2832
=head2 C<update_param>
2833

            
2834
Updata parameter tag.
2835

            
2836
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2837

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

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

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

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

            
2847
C<< <kimoto.yuki at gmail.com> >>
2848

            
2849
L<http://github.com/yuki-kimoto/DBIx-Custom>
2850

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2851
=head1 AUTHOR
2852

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

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

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

            
2859
This program is free software; you can redistribute it and/or modify it
2860
under the same terms as Perl itself.
2861

            
2862
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2863

            
2864