DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2861 lines | 68.765kb
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 _remove_duplicate_table {
407
    my ($self, $tables, $main_table) = @_;
408
    
409
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
410
    delete $tables{$main_table} if $main_table;
411
    
412
    return [keys %tables, $main_table ? $main_table : ()];
413
}
414

            
415
sub execute {
cleanup
yuki-kimoto authored on 2010-10-17
416
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
417
    
cleanup
Yuki Kimoto authored on 2011-04-02
418
    # Arguments
419
    my $params = delete $args{param} || {};
420
    my $tables = delete $args{table} || [];
421
    $tables = [$tables] unless ref $tables eq 'ARRAY';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
422
    
cleanup
Yuki Kimoto authored on 2011-03-09
423
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
424
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
425
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
426
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
427
    }
428
    
cleanup
Yuki Kimoto authored on 2011-04-02
429
    # Create query
430
    $query = $self->create_query($query) unless ref $query;
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
431
    
cleanup
Yuki Kimoto authored on 2011-04-02
432
    # Tables
433
    unshift @$tables, @{$query->tables};
cleanup
Yuki Kimoto authored on 2011-03-09
434
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
435
    my $main_table = pop @$tables;
cleanup
Yuki Kimoto authored on 2011-04-02
436
    $tables = $self->_remove_duplicate_table($tables, $main_table);
437
    if (my $q = $self->reserved_word_quote) {
438
        $_ =~ s/$q//g for @$tables;
439
    }
440

            
441
    foreach my $table (@$tables) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
442
        
443
        if (my $dist = $self->{_table_alias}->{$table}) {
444
            $self->{filter} ||= {};
445
            
446
            unless ($self->{filter}{out}{$table}) {
447
                $self->{filter}{out} ||= {};
448
                $self->{filter}{in}  ||= {};
449
                $self->{filter}{end} ||= {};
450
                
451
                foreach my $type (qw/out in end/) {
452
                    
453
                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {
454
                        my $filter_name_alias = $filter_name;
455
                        $filter_name_alias =~ s/^$dist\./$table\./;
456
                        $filter_name_alias =~ s/^${dist}__/${table}__/; 
457
                        
458
                        $self->{filter}{$type}{$table}{$filter_name_alias}
459
                          = $self->{filter}{$type}{$dist}{$filter_name}
460
                    }
461
                }
462
            }
463
        }
464
    }
cleanup
Yuki Kimoto authored on 2011-04-02
465

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

            
543
        return $result;
544
    }
545
    return $affected;
546
}
547

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

            
cleanup
yuki-kimoto authored on 2010-10-17
550
sub insert {
551
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
552
    
cleanup
Yuki Kimoto authored on 2011-04-02
553
    # Reserved word quote
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
554
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
555

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
756
sub method {
757
    my $self = shift;
758
    
759
    # Merge
760
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
761
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
762
    
763
    return $self;
764
}
765

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
783
sub mycolumn {
784
    my ($self, $table, $columns) = @_;
785
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
786
    my $q = $self->reserved_word_quote;
787
    
cleanup
Yuki Kimoto authored on 2011-03-21
788
    $columns ||= [];
789
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
790
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
791
    
792
    return join (', ', @column);
793
}
794

            
added dbi_options attribute
kimoto authored on 2010-12-20
795
sub new {
796
    my $self = shift->SUPER::new(@_);
797
    
798
    # Check attribute names
799
    my @attrs = keys %$self;
800
    foreach my $attr (@attrs) {
801
        croak qq{"$attr" is invalid attribute name}
802
          unless $self->can($attr);
803
    }
cleanup
Yuki Kimoto authored on 2011-01-25
804

            
805
    $self->register_tag(
806
        '?'     => \&DBIx::Custom::Tag::placeholder,
807
        '='     => \&DBIx::Custom::Tag::equal,
808
        '<>'    => \&DBIx::Custom::Tag::not_equal,
809
        '>'     => \&DBIx::Custom::Tag::greater_than,
810
        '<'     => \&DBIx::Custom::Tag::lower_than,
811
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
812
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
813
        'like'  => \&DBIx::Custom::Tag::like,
814
        'in'    => \&DBIx::Custom::Tag::in,
815
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
816
        'update_param' => \&DBIx::Custom::Tag::update_param
817
    );
added dbi_options attribute
kimoto authored on 2010-12-20
818
    
819
    return $self;
820
}
821

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

            
cleanup
yuki-kimoto authored on 2010-10-17
824
sub register_filter {
825
    my $invocant = shift;
826
    
827
    # Register filter
828
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
829
    $invocant->filters({%{$invocant->filters}, %$filters});
830
    
831
    return $invocant;
832
}
packaging one directory
yuki-kimoto authored on 2009-11-16
833

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

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

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

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

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

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

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1010
sub setup_model {
1011
    my $self = shift;
1012
    
1013
    $self->each_column(
1014
        sub {
1015
            my ($self, $table, $column, $column_info) = @_;
1016
            
1017
            if (my $model = $self->models->{$table}) {
1018
                push @{$model->columns}, $column;
1019
            }
1020
        }
1021
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1022
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1023
}
1024

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

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

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

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

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

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

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

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

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

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

            
1183
    return DBIx::Custom::Where->new(
1184
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1185
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1186
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1187
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1188
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1189
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1190

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1285
sub _need_tables {
1286
    my ($self, $tree, $need_tables, $tables) = @_;
1287
    
1288
    foreach my $table (@$tables) {
1289
        
1290
        if ($tree->{$table}) {
1291
            $need_tables->{$table} = 1;
1292
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1293
        }
1294
    }
1295
}
1296

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1297
sub _tables {
1298
    my ($self, $source) = @_;
1299
    
1300
    my $tables = [];
1301
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1302
    my $safety_character = $self->safety_character;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1303
    my $q = $self->reserved_word_quote;
1304
    my $q_re = quotemeta($q);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1305
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1306
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1307
                      : qr/\b([$safety_character]+)\./;
1308
    while ($source =~ /$table_re/g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1309
        push @$tables, $1;
1310
    }
1311
    
1312
    return $tables;
1313
}
1314

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1315
sub _push_join {
1316
    my ($self, $sql, $join, $join_tables) = @_;
1317
    
1318
    return unless @$join;
1319
    
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1320
    my $q = $self->reserved_word_quote;
1321
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1322
    my $tree = {};
1323
    
1324
    for (my $i = 0; $i < @$join; $i++) {
1325
        
1326
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1327
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1328
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1329
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1330
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1331
            
1332
            my $table1 = $1;
1333
            my $table2 = $2;
1334
            
1335
            croak qq{right side table of "$join_clause" must be uniq}
1336
              if exists $tree->{$table2};
1337
            
1338
            $tree->{$table2}
1339
              = {position => $i, parent => $table1, join => $join_clause};
1340
        }
1341
        else {
1342
            croak qq{join "$join_clause" must be two table name};
1343
        }
1344
    }
1345
    
1346
    my $need_tables = {};
1347
    $self->_need_tables($tree, $need_tables, $join_tables);
1348
    
1349
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1350

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1351
    foreach my $need_table (@need_tables) {
1352
        push @$sql, $tree->{$need_table}{join};
1353
    }
1354
}
cleanup
Yuki Kimoto authored on 2011-03-08
1355

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1585
Filter when data is send or receive.
1586

            
1587
=item *
1588

            
1589
Data filtering system
1590

            
1591
=item *
1592

            
1593
Model support.
1594

            
1595
=item *
1596

            
1597
Generate where clause dinamically.
1598

            
1599
=item *
1600

            
1601
Generate join clause dinamically.
1602

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

            
1605
=head1 GUIDE
1606

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

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

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

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

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

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

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

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

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

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

            
1630
=head2 C<default_dbi_option>
1631

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1741
You can set multiple filters at once.
1742

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1812
=head2 C<each_column>
1813

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

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

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

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

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

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

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

            
1847
See also L<Tags/Tags>.
1848

            
1849
The following opitons are currently available.
1850

            
1851
=over 4
1852

            
1853
=item C<filter>
1854

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

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

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

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

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

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

            
1893
Delete statement.
1894

            
1895
The following opitons are currently available.
1896

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

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

            
1901
Table name.
1902

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

            
1905
=item C<where>
1906

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

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

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

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

            
1934
=item C<filter>
1935

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

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

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

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

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

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

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

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

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

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

            
1981
You can check SQL.
1982

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2020
This is used to create where clause.
2021

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

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

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

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

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

            
2035
    delete from book where id = ?;
2036

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

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

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

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

            
2048
Insert statement.
2049

            
2050
The following opitons are currently available.
2051

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

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

            
2056
Table name.
2057

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

            
2060
=item C<param>
2061

            
2062
Insert data. This is hash reference.
2063

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

            
2066
=item C<append>
2067

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

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

            
2072
=item C<filter>
2073

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2168
Create insert parameter tag.
2169

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2224
Merge paramters.
2225

            
2226
$param:
2227

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2354
Replace join clauses if match the expression.
2355

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

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

            
2366
The following opitons are currently available.
2367

            
2368
=over 4
2369

            
2370
=item C<table>
2371

            
2372
Table name.
2373

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

            
2376
=item C<column>
2377

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

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

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

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

            
2391
=item C<where>
2392

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2467
=item C<filter>
2468

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

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

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

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

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

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

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

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

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

            
2511
Specify database data type.
2512

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2563
    select * from book where id = ?
2564

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

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

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

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

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

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

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

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

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

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

            
2589
=item C<param>
2590

            
2591
Update data. This is hash reference.
2592

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

            
2595
=item C<where>
2596

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

            
2618
=item C<append>
2619

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

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

            
2624
=item C<filter>
2625

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

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

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

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

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

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

            
2662
You can check SQL.
2663

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2702
This is used to create where clause.
2703

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

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

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

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

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

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

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

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

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

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

            
2727
Create update parameter tag.
2728

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

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

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

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

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

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

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

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

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

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

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

            
2759
The following tags is available.
2760

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

            
2763
Table tag
2764

            
2765
    {table TABLE}    ->    TABLE
2766

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

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

            
2771
Placeholder tag.
2772

            
2773
    {? NAME}    ->   ?
2774

            
2775
=head2 C<=>
2776

            
2777
Equal tag.
2778

            
2779
    {= NAME}    ->   NAME = ?
2780

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

            
2783
Not equal tag.
2784

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

            
2787
=head2 C<E<lt>>
2788

            
2789
Lower than tag
2790

            
2791
    {< NAME}    ->   NAME < ?
2792

            
2793
=head2 C<E<gt>>
2794

            
2795
Greater than tag
2796

            
2797
    {> NAME}    ->   NAME > ?
2798

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

            
2801
Greater than or equal tag
2802

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

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

            
2807
Lower than or equal tag
2808

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

            
2811
=head2 C<like>
2812

            
2813
Like tag
2814

            
2815
    {like NAME}   ->   NAME like ?
2816

            
2817
=head2 C<in>
2818

            
2819
In tag.
2820

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

            
2823
=head2 C<insert_param>
2824

            
2825
Insert parameter tag.
2826

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

            
2829
=head2 C<update_param>
2830

            
2831
Updata parameter tag.
2832

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2861