DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2797 lines | 67.526kb
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 environment variable D...
Yuki Kimoto authored on 2011-04-02
22
use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
23

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
321
sub delete_at {
322
    my ($self, %args) = @_;
323
    
cleanup
Yuki Kimoto authored on 2011-04-02
324
    # Arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
325
    my $primary_keys = delete $args{primary_key};
326
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-04-02
327
    my $where = delete $args{where};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
328
    
cleanup
Yuki Kimoto authored on 2011-04-02
329
    # Check arguments
330
    foreach my $name (keys %args) {
331
        croak qq{Argument "$name" is wrong name}
332
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
333
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
334
    
cleanup
Yuki Kimoto authored on 2011-04-02
335
    # Create where parameter
336
    my $where_param = $self->_create_where_param($where, $primary_keys);
337

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
338
    
cleanup
Yuki Kimoto authored on 2011-04-02
339
    return $self->delete(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
340
}
341

            
added helper method
yuki-kimoto authored on 2010-10-17
342
sub DESTROY { }
343

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

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

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

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

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

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

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

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

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

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

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

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

            
592
    # Arguments
593
    my $primary_keys = delete $args{primary_key};
594
    $primary_keys = [$primary_keys] unless ref $primary_keys;
595
    my $where = delete $args{where};
596
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
597
    
cleanup
Yuki Kimoto authored on 2011-04-02
598
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
599
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
600
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
601
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
602
    }
603
    
cleanup
Yuki Kimoto authored on 2011-04-02
604
    # Create where parameter
605
    my $where_param = $self->_create_where_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-04-02
606
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
607
    
608
    return $self->insert(param => $param, %args);
609
}
610

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

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
632
sub include_model {
633
    my ($self, $name_space, $model_infos) = @_;
634
    
cleanup
Yuki Kimoto authored on 2011-04-02
635
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
636
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
637
    
638
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
639
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
640

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
695
sub merge_param {
696
    my ($self, @params) = @_;
697
    
cleanup
Yuki Kimoto authored on 2011-04-02
698
    # Merge parameters
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
699
    my $param = {};
700
    foreach my $p (@params) {
701
        foreach my $column (keys %$p) {
702
            if (exists $param->{$column}) {
703
                $param->{$column} = [$param->{$column}]
704
                  unless ref $param->{$column} eq 'ARRAY';
705
                push @{$param->{$column}}, $p->{$column};
706
            }
707
            else {
708
                $param->{$column} = $p->{$column};
709
            }
710
        }
711
    }
712
    
713
    return $param;
714
}
715

            
cleanup
Yuki Kimoto authored on 2011-03-21
716
sub method {
717
    my $self = shift;
718
    
cleanup
Yuki Kimoto authored on 2011-04-02
719
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
720
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
721
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
722
    
723
    return $self;
724
}
725

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
726
sub model {
727
    my ($self, $name, $model) = @_;
728
    
cleanup
Yuki Kimoto authored on 2011-04-02
729
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
730
    if ($model) {
731
        $self->models->{$name} = $model;
732
        return $self;
733
    }
734
    
735
    # Check model existance
736
    croak qq{Model "$name" is not included}
737
      unless $self->models->{$name};
738
    
cleanup
Yuki Kimoto authored on 2011-04-02
739
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
740
    return $self->models->{$name};
741
}
742

            
cleanup
Yuki Kimoto authored on 2011-03-21
743
sub mycolumn {
744
    my ($self, $table, $columns) = @_;
745
    
cleanup
Yuki Kimoto authored on 2011-04-02
746
    # Create column clause
747
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
748
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
749
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
750
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
751
    
752
    return join (', ', @column);
753
}
754

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
785
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
786
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
787
    
788
    # Register filter
789
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
790
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
791
    
cleanup
Yuki Kimoto authored on 2011-04-02
792
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
793
}
packaging one directory
yuki-kimoto authored on 2009-11-16
794

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
797
sub replace {
798
    my ($self, $join, $search, $replace) = @_;
799
    
cleanup
Yuki Kimoto authored on 2011-04-02
800
    # Replace
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
801
    my @replace_join;
802
    my $is_replaced;
803
    foreach my $j (@$join) {
804
        if ($search eq $j) {
805
            push @replace_join, $replace;
806
            $is_replaced = 1;
807
        }
808
        else {
809
            push @replace_join, $j;
810
        }
811
    }
812
    croak qq{Can't replace "$search" with "$replace"} unless $is_replaced;
813
    
814
    return @replace_join;
815
}
816

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

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
823
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
824
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
825
    my $tables = ref $table eq 'ARRAY' ? $table
826
               : defined $table ? [$table]
827
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
828
    my $columns   = delete $args{column};
829
    my $where     = delete $args{where} || {};
830
    my $append    = delete $args{append};
831
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
832
    croak qq{"join" must be array reference}
833
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
834
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
835
    my $param = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
836
    my $query_return = $args{query};
837

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

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

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

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

            
928
    # Arguments
929
    my $primary_keys = delete $args{primary_key};
930
    $primary_keys = [$primary_keys] unless ref $primary_keys;
931
    my $where = delete $args{where};
932
    my $param = delete $args{param};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
933
    
cleanup
Yuki Kimoto authored on 2011-04-02
934
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
935
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
936
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
937
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
938
    }
939
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
940
    # Table
941
    croak qq{"table" option must be specified} unless $args{table};
942
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
943
    
cleanup
Yuki Kimoto authored on 2011-04-02
944
    # Create where parameter
945
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
946
    
cleanup
Yuki Kimoto authored on 2011-04-02
947
    return $self->select(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
948
}
949

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
950
sub setup_model {
951
    my $self = shift;
952
    
cleanup
Yuki Kimoto authored on 2011-04-02
953
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
954
    $self->each_column(
955
        sub {
956
            my ($self, $table, $column, $column_info) = @_;
957
            if (my $model = $self->models->{$table}) {
958
                push @{$model->columns}, $column;
959
            }
960
        }
961
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
962
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
963
}
964

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
971
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
972
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
973
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
974
    my $param            = delete $args{param} || {};
975
    my $where            = delete $args{where} || {};
976
    my $append           = delete $args{append} || '';
977
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
978
    
cleanup
Yuki Kimoto authored on 2011-04-02
979
    # Check argument names
980
    foreach my $name (keys %args) {
981
        croak qq{Argument "$name" is wrong name}
982
          unless $UPDATE_ARGS{$name};
983
    }
984
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
985
    # Columns
986
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
987
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
988
    my $q = $self->reserved_word_quote;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
989
    foreach my $column (keys %$param) {
990
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
991
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
992
          $column = "$q$column$q";
993
          $column =~ s/\./$q.$q/;
994
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
995
    }
996
        
cleanup
yuki-kimoto authored on 2010-10-17
997
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
998
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
999

            
1000
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
1001
    $where = $self->_where_to_obj($where);
1002
    my $where_clause = $where->to_string;
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1003
    croak qq{"where" must be specified}
cleanup
Yuki Kimoto authored on 2011-04-02
1004
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1005
    
cleanup
Yuki Kimoto authored on 2011-04-02
1006
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
1007
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
1008
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
1009
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1010
    
cleanup
Yuki Kimoto authored on 2011-04-02
1011
    # Merge parameters
1012
    $param = $self->merge_param($param, $where->param);
cleanup
yuki-kimoto authored on 2010-10-17
1013
    
cleanup
Yuki Kimoto authored on 2011-01-27
1014
    # SQL
1015
    my $sql = join(' ', @sql);
1016
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1017
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1018
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1019
    return $query if $args{query};
1020
    
cleanup
yuki-kimoto authored on 2010-10-17
1021
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1022
    my $ret_val = $self->execute(
1023
        $query,
1024
        param  => $param, 
1025
        table => $table,
1026
        %args
1027
    );
cleanup
yuki-kimoto authored on 2010-10-17
1028
    
1029
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1030
}
1031

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

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

            
1036
sub update_at {
1037
    my ($self, %args) = @_;
1038
    
cleanup
Yuki Kimoto authored on 2011-04-02
1039
    # Arguments
1040
    my $primary_keys = delete $args{primary_key};
1041
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1042
    my $where = delete $args{where};
1043
    
1044

            
1045
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1046
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1047
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1048
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1049
    }
1050
    
cleanup
Yuki Kimoto authored on 2011-04-02
1051
    # Create where parameter
1052
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1053
    
cleanup
Yuki Kimoto authored on 2011-04-02
1054
    return $self->update(where => $where_param, %args);
1055
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1056

            
cleanup
Yuki Kimoto authored on 2011-04-02
1057
sub _create_where_param {
1058
    my ($self, $where, $primary_keys) = @_;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1059
    
cleanup
Yuki Kimoto authored on 2011-04-02
1060
    # Create where parameter
1061
    my $where_param = {};
1062
    if ($where) {
1063
        $where = [$where] unless ref $where;
1064
        croak qq{"where" must be constant value or array reference}
1065
          unless !ref $where || ref $where eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1066
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
1067
           $where_param->{$primary_keys->[$i]} = $where->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1068
        }
1069
    }
1070
    
cleanup
Yuki Kimoto authored on 2011-04-02
1071
    return $where_param;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1072
}
1073

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1074
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1075
    my ($self, $param, $opt) = @_;
1076
    
cleanup
Yuki Kimoto authored on 2011-04-02
1077
    # Create update parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1078
    my @params;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1079
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1080
    my $q = $self->reserved_word_quote;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1081
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1082
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1083
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
1084
        my $column = "$q$column$q";
1085
        $column =~ s/\./$q.$q/;
1086
        push @params, "$column = {? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1087
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1088
    my $tag;
1089
    $tag .= 'set ' unless $opt->{no_set};
1090
    $tag .= join(', ', @params);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1091
    
cleanup
Yuki Kimoto authored on 2011-04-02
1092
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1093
}
1094

            
cleanup
Yuki Kimoto authored on 2011-01-25
1095
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1096
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1097
    
1098
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1099
    return DBIx::Custom::Where->new(
1100
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1101
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1102
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1103
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1104
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1105
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1106

            
cleanup
Yuki Kimoto authored on 2011-04-02
1107
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1108
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1109
    
cleanup
Yuki Kimoto authored on 2011-04-02
1110
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1111
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1112
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1113
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1114
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1115
        
1116
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1117
        my $value;
1118
        if(ref $params->{$column} eq 'ARRAY') {
1119
            my $i = $count->{$column} || 0;
1120
            $i += $not_exists->{$column} || 0;
1121
            my $found;
1122
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1123
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1124
                    $not_exists->{$column}++;
1125
                }
1126
                else  {
1127
                    $value = $params->{$column}->[$k];
1128
                    $found = 1;
1129
                    last
1130
                }
1131
            }
1132
            next unless $found;
1133
        }
1134
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1135
        
cleanup
Yuki Kimoto authored on 2011-01-12
1136
        # Filter
1137
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1138
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1139
        # Type
1140
        push @$bind, {
1141
            value => $f ? $f->($value) : $value,
1142
            type => $type->{$column}
1143
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1144
        
1145
        # Count up 
1146
        $count->{$column}++;
1147
    }
1148
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1149
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1150
}
1151

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1152
sub _connect {
1153
    my $self = shift;
1154
    
1155
    # Attributes
1156
    my $data_source = $self->data_source;
1157
    croak qq{"data_source" must be specified to connect()"}
1158
      unless $data_source;
1159
    my $user        = $self->user;
1160
    my $password    = $self->password;
1161
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1162
    
1163
    # Connect
1164
    my $dbh = eval {DBI->connect(
1165
        $data_source,
1166
        $user,
1167
        $password,
1168
        {
1169
            %{$self->default_dbi_option},
1170
            %$dbi_option
1171
        }
1172
    )};
1173
    
1174
    # Connect error
1175
    croak $@ if $@;
1176
    
1177
    return $dbh;
1178
}
1179

            
cleanup
yuki-kimoto authored on 2010-10-17
1180
sub _croak {
1181
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1182
    
1183
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1184
    $append ||= "";
1185
    
1186
    # Verbose
1187
    if ($Carp::Verbose) { croak $error }
1188
    
1189
    # Not verbose
1190
    else {
1191
        
1192
        # Remove line and module infromation
1193
        my $at_pos = rindex($error, ' at ');
1194
        $error = substr($error, 0, $at_pos);
1195
        $error =~ s/\s+$//;
1196
        croak "$error$append";
1197
    }
1198
}
1199

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1200
sub _need_tables {
1201
    my ($self, $tree, $need_tables, $tables) = @_;
1202
    
cleanup
Yuki Kimoto authored on 2011-04-02
1203
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1204
    foreach my $table (@$tables) {
1205
        if ($tree->{$table}) {
1206
            $need_tables->{$table} = 1;
1207
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1208
        }
1209
    }
1210
}
1211

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1212
sub _push_join {
1213
    my ($self, $sql, $join, $join_tables) = @_;
1214
    
cleanup
Yuki Kimoto authored on 2011-04-02
1215
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1216
    return unless @$join;
1217
    
cleanup
Yuki Kimoto authored on 2011-04-02
1218
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1219
    my $tree = {};
cleanup
Yuki Kimoto authored on 2011-04-02
1220
    my $q = $self->reserved_word_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1221
    for (my $i = 0; $i < @$join; $i++) {
1222
        
cleanup
Yuki Kimoto authored on 2011-04-02
1223
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1224
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1225
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1226
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1227
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1228
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1229
            my $table1 = $1;
1230
            my $table2 = $2;
1231
            croak qq{right side table of "$join_clause" must be uniq}
1232
              if exists $tree->{$table2};
1233
            $tree->{$table2}
1234
              = {position => $i, parent => $table1, join => $join_clause};
1235
        }
1236
        else {
1237
            croak qq{join "$join_clause" must be two table name};
1238
        }
1239
    }
1240
    
cleanup
Yuki Kimoto authored on 2011-04-02
1241
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1242
    my $need_tables = {};
1243
    $self->_need_tables($tree, $need_tables, $join_tables);
1244
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1245
    
1246
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1247
    foreach my $need_table (@need_tables) {
1248
        push @$sql, $tree->{$need_table}{join};
1249
    }
1250
}
cleanup
Yuki Kimoto authored on 2011-03-08
1251

            
cleanup
Yuki Kimoto authored on 2011-04-02
1252
sub _remove_duplicate_table {
1253
    my ($self, $tables, $main_table) = @_;
1254
    
1255
    # Remove duplicate table
1256
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1257
    delete $tables{$main_table} if $main_table;
1258
    
1259
    return [keys %tables, $main_table ? $main_table : ()];
1260
}
1261

            
cleanup
Yuki Kimoto authored on 2011-04-02
1262
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1263
    my ($self, $source) = @_;
1264
    
cleanup
Yuki Kimoto authored on 2011-04-02
1265
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1266
    my $tables = [];
1267
    my $safety_character = $self->safety_character;
1268
    my $q = $self->reserved_word_quote;
1269
    my $q_re = quotemeta($q);
1270
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1271
                      : qr/\b([$safety_character]+)\./;
1272
    while ($source =~ /$table_re/g) {
1273
        push @$tables, $1;
1274
    }
1275
    
1276
    return $tables;
1277
}
1278

            
cleanup
Yuki Kimoto authored on 2011-04-02
1279
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1280
    my ($self, $where) = @_;
1281
    
cleanup
Yuki Kimoto authored on 2011-04-02
1282
    my $obj;
1283
    
1284
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1285
    if (ref $where eq 'HASH') {
1286
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1287
        my $q = $self->reserved_word_quote;
1288
        foreach my $column (keys %$where) {
1289
            $column = "$q$column$q";
1290
            $column =~ s/\./$q.$q/;
1291
            push @$clause, "{= $column}" for keys %$where;
1292
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1293
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1294
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1295
    
1296
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1297
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1298
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1299
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1300
    
1301
    # Array(DEPRECATED!)
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1302
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1303
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1304
             "use \$dbi->select(where => \$dbi->where(clause => " .
1305
             "CLAUSE, param => PARAMETER));";
cleanup
Yuki Kimoto authored on 2011-04-02
1306
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1307
            clause => $where->[0],
1308
            param  => $where->[1]
1309
        );
1310
    }
1311
    
cleanup
Yuki Kimoto authored on 2011-04-02
1312
    # Check where argument
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1313
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1314
          qq{or array reference, which contains where clause and paramter}
cleanup
Yuki Kimoto authored on 2011-04-02
1315
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1316
    
cleanup
Yuki Kimoto authored on 2011-04-02
1317
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1318
}
1319

            
cleanup
Yuki Kimoto authored on 2011-01-25
1320
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1321
__PACKAGE__->attr(
1322
    dbi_options => sub { {} },
1323
    filter_check  => 1
1324
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1325

            
cleanup
Yuki Kimoto authored on 2011-01-25
1326
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1327
sub default_bind_filter {
1328
    my $self = shift;
1329
    
1330
    if (@_) {
1331
        my $fname = $_[0];
1332
        
1333
        if (@_ && !$fname) {
1334
            $self->{default_out_filter} = undef;
1335
        }
1336
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1337
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1338
              unless exists $self->filters->{$fname};
1339
        
1340
            $self->{default_out_filter} = $self->filters->{$fname};
1341
        }
1342
        return $self;
1343
    }
1344
    
1345
    return $self->{default_out_filter};
1346
}
1347

            
cleanup
Yuki Kimoto authored on 2011-01-25
1348
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1349
sub default_fetch_filter {
1350
    my $self = shift;
1351
    
1352
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1353
        my $fname = $_[0];
1354

            
cleanup
Yuki Kimoto authored on 2011-01-12
1355
        if (@_ && !$fname) {
1356
            $self->{default_in_filter} = undef;
1357
        }
1358
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1359
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1360
              unless exists $self->filters->{$fname};
1361
        
1362
            $self->{default_in_filter} = $self->filters->{$fname};
1363
        }
1364
        
1365
        return $self;
1366
    }
1367
    
many changed
Yuki Kimoto authored on 2011-01-23
1368
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1369
}
1370

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1371
# DEPRECATED!
1372
sub insert_param {
1373
    warn "insert_param is renamed to insert_param_tag."
1374
       . " insert_param is DEPRECATED!";
1375
    return shift->insert_param_tag(@_);
1376
}
1377

            
cleanup
Yuki Kimoto authored on 2011-01-25
1378
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1379
sub register_tag_processor {
1380
    return shift->query_builder->register_tag_processor(@_);
1381
}
1382

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1383
# DEPRECATED!
1384
sub update_param {
1385
    warn "update_param is renamed to update_param_tag."
1386
       . " update_param is DEPRECATED!";
1387
    return shift->update_param_tag(@_);
1388
}
cleanup
Yuki Kimoto authored on 2011-03-08
1389
# DEPRECATED!
1390
sub _push_relation {
1391
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1392
    
1393
    if (keys %{$relation || {}}) {
1394
        push @$sql, $need_where ? 'where' : 'and';
1395
        foreach my $rcolumn (keys %$relation) {
1396
            my $table1 = (split (/\./, $rcolumn))[0];
1397
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1398
            push @$tables, ($table1, $table2);
1399
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1400
        }
1401
    }
1402
    pop @$sql if $sql->[-1] eq 'and';    
1403
}
1404

            
1405
# DEPRECATED!
1406
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1407
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1408
    
1409
    if (keys %{$relation || {}}) {
1410
        foreach my $rcolumn (keys %$relation) {
1411
            my $table1 = (split (/\./, $rcolumn))[0];
1412
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1413
            my $table1_exists;
1414
            my $table2_exists;
1415
            foreach my $table (@$tables) {
1416
                $table1_exists = 1 if $table eq $table1;
1417
                $table2_exists = 1 if $table eq $table2;
1418
            }
1419
            unshift @$tables, $table1 unless $table1_exists;
1420
            unshift @$tables, $table2 unless $table2_exists;
1421
        }
1422
    }
1423
}
1424

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1427
=head1 NAME
1428

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

            
1431
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1432

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1433
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1434
    
1435
    # Connect
1436
    my $dbi = DBIx::Custom->connect(
1437
        data_source => "dbi:mysql:database=dbname",
1438
        user => 'ken',
1439
        password => '!LFKD%$&',
1440
        dbi_option => {mysql_enable_utf8 => 1}
1441
    );
cleanup
yuki-kimoto authored on 2010-08-05
1442

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1443
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1444
    $dbi->insert(
1445
        table  => 'book',
1446
        param  => {title => 'Perl', author => 'Ken'}
1447
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1448
    
1449
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1450
    $dbi->update(
1451
        table  => 'book', 
1452
        param  => {title => 'Perl', author => 'Ken'}, 
1453
        where  => {id => 5},
1454
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1455
    
1456
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1457
    $dbi->delete(
1458
        table  => 'book',
1459
        where  => {author => 'Ken'},
1460
    );
cleanup
yuki-kimoto authored on 2010-08-05
1461

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1468
    # Select, more complex
1469
    my $result = $dbi->select(
1470
        table  => 'book',
1471
        column => [
1472
            'book.author as book__author',
1473
            'company.name as company__name'
1474
        ],
1475
        where  => {'book.author' => 'Ken'},
1476
        join => ['left outer join company on book.company_id = company.id'],
1477
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1478
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1479
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1480
    # Fetch
1481
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1482
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1483
    }
1484
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1485
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1486
    while (my $row = $result->fetch_hash) {
1487
        
1488
    }
1489
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1490
    # Execute SQL with parameter.
1491
    $dbi->execute(
1492
        "select id from book where {= author} and {like title}",
1493
        param  => {author => 'ken', title => '%Perl%'}
1494
    );
1495
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1496
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1497

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

            
1500
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1501

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1506
There are many basic methods to execute various queries.
1507
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1508
C<delete_all()>, C<select()>,
1509
C<insert_at()>, C<update_at()>, 
1510
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1511

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1512
=item *
1513

            
1514
Filter when data is send or receive.
1515

            
1516
=item *
1517

            
1518
Data filtering system
1519

            
1520
=item *
1521

            
1522
Model support.
1523

            
1524
=item *
1525

            
1526
Generate where clause dinamically.
1527

            
1528
=item *
1529

            
1530
Generate join clause dinamically.
1531

            
1532
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1533

            
1534
=head1 GUIDE
1535

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

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

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

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

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

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

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

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

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

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

            
1559
=head2 C<default_dbi_option>
1560

            
1561
    my $default_dbi_option = $dbi->default_dbi_option;
1562
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1563

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1567
    {
1568
        RaiseError => 1,
1569
        PrintError => 0,
1570
        AutoCommit => 1,
1571
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1572

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

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

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

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

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

            
1585
    my $models = $dbi->models;
1586
    $dbi       = $dbi->models(\%models);
1587

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1590
=head2 C<password>
1591

            
1592
    my $password = $dbi->password;
1593
    $dbi         = $dbi->password('lkj&le`@s');
1594

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

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

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

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

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

            
1606
     my reserved_word_quote = $dbi->reserved_word_quote;
1607
     $dbi                   = $dbi->reserved_word_quote('"');
1608

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1628
    my $user = $dbi->user;
1629
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1630

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

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

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

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

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1641
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1642
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1643
        'issue_date' => {
1644
            out => 'tp_to_date',
1645
            in  => 'date_to_tp',
1646
            end => 'tp_to_displaydate'
1647
        },
1648
        'write_date' => {
1649
            out => 'tp_to_date',
1650
            in  => 'date_to_tp',
1651
            end => 'tp_to_displaydate'
1652
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1653
    );
1654

            
update pod
Yuki Kimoto authored on 2011-03-13
1655
Apply filter to columns.
1656
C<out> filter is executed before data is send to database.
1657
C<in> filter is executed after a row is fetch.
1658
C<end> filter is execute after C<in> filter is executed.
1659

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1662
       PETTERN         EXAMPLE
1663
    1. Column        : author
1664
    2. Table.Column  : book.author
1665
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1666

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

            
1670
You can set multiple filters at once.
1671

            
1672
    $dbi->apply_filter(
1673
        'book',
1674
        [qw/issue_date write_date/] => {
1675
            out => 'tp_to_date',
1676
            in  => 'date_to_tp',
1677
            end => 'tp_to_displaydate'
1678
        }
1679
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1680

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1683
    my $dbi = DBIx::Custom->connect(
1684
        data_source => "dbi:mysql:database=dbname",
1685
        user => 'ken',
1686
        password => '!LFKD%$&',
1687
        dbi_option => {mysql_enable_utf8 => 1}
1688
    );
1689

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1698
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1699
        table => 'book',
1700
        primary_key => 'id',
1701
        join => [
1702
            'inner join company on book.comparny_id = company.id'
1703
        ],
1704
        filter => [
1705
            publish_date => {
1706
                out => 'tp_to_date',
1707
                in => 'date_to_tp',
1708
                end => 'tp_to_displaydate'
1709
            }
1710
        ]
1711
    );
1712

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

            
1716
   $dbi->model('book')->select(...);
1717

            
cleanup
yuki-kimoto authored on 2010-10-17
1718
=head2 C<create_query>
1719
    
1720
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1721
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1722
    );
update document
yuki-kimoto authored on 2009-11-19
1723

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

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

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

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

            
1734
    my $dbh = $dbi->dbh;
1735
    $dbi    = $dbi->dbh($dbh);
1736

            
1737
Get and set database handle of L<DBI>.
1738

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

            
1741
=head2 C<each_column>
1742

            
1743
    $dbi->each_column(
1744
        sub {
1745
            my ($dbi, $table, $column, $column_info) = @_;
1746
            
1747
            my $type = $column_info->{TYPE_NAME};
1748
            
1749
            if ($type eq 'DATE') {
1750
                # ...
1751
            }
1752
        }
1753
    );
1754

            
1755
Iterate all column informations of all table from database.
1756
Argument is callback when one column is found.
1757
Callback receive four arguments, dbi object, table name,
1758
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1759

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1762
    my $result = $dbi->execute(
1763
        "select * from book where {= title} and {like author}",
1764
        param => {title => 'Perl', author => '%Ken%'}
1765
    );
1766

            
1767
Execute SQL, containing tags.
1768
Return value is L<DBIx::Custom::Result> in select statement, or
1769
the count of affected rows in insert, update, delete statement.
1770

            
1771
Tag is turned into the statement containing place holder
1772
before SQL is executed.
1773

            
1774
    select * from where title = ? and author like ?;
1775

            
1776
See also L<Tags/Tags>.
1777

            
1778
The following opitons are currently available.
1779

            
1780
=over 4
1781

            
1782
=item C<filter>
1783

            
1784
Filter, executed before data is send to database. This is array reference.
1785
Filter value is code reference or
1786
filter name registerd by C<register_filter()>.
1787

            
1788
    # Basic
1789
    $dbi->execute(
1790
        $sql,
1791
        filter => [
1792
            title  => sub { uc $_[0] }
1793
            author => sub { uc $_[0] }
1794
        ]
1795
    );
1796
    
1797
    # At once
1798
    $dbi->execute(
1799
        $sql,
1800
        filter => [
1801
            [qw/title author/]  => sub { uc $_[0] }
1802
        ]
1803
    );
1804
    
1805
    # Filter name
1806
    $dbi->execute(
1807
        $sql,
1808
        filter => [
1809
            title  => 'upper_case',
1810
            author => 'upper_case'
1811
        ]
1812
    );
1813

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

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

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

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

            
1822
Delete statement.
1823

            
1824
The following opitons are currently available.
1825

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

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

            
1830
Table name.
1831

            
1832
    $dbi->delete(table => 'book');
1833

            
1834
=item C<where>
1835

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1836
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1837
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1838
    
1839
    # Hash reference
1840
    $dbi->delete(where => {title => 'Perl'});
1841
    
1842
    # DBIx::Custom::Where object
1843
    my $where = $dbi->where(
1844
        clause => ['and', '{= author}', '{like title}'],
1845
        param  => {author => 'Ken', title => '%Perl%'}
1846
    );
1847
    $dbi->delete(where => $where);
1848

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1849
    # Array refrendce (where clause and parameter)
1850
    $dbi->delete(where =>
1851
        [
1852
            ['and', '{= author}', '{like title}'],
1853
            {author => 'Ken', title => '%Perl%'}
1854
        ]
1855
    );
1856
    
update pod
Yuki Kimoto authored on 2011-03-13
1857
=item C<append>
1858

            
1859
Append statement to last of SQL. This is string.
1860

            
1861
    $dbi->delete(append => 'order by title');
1862

            
1863
=item C<filter>
1864

            
1865
Filter, executed before data is send to database. This is array reference.
1866
Filter value is code reference or
1867
filter name registerd by C<register_filter()>.
1868

            
1869
    # Basic
1870
    $dbi->delete(
1871
        filter => [
1872
            title  => sub { uc $_[0] }
1873
            author => sub { uc $_[0] }
1874
        ]
1875
    );
1876
    
1877
    # At once
1878
    $dbi->delete(
1879
        filter => [
1880
            [qw/title author/]  => sub { uc $_[0] }
1881
        ]
1882
    );
1883
    
1884
    # Filter name
1885
    $dbi->delete(
1886
        filter => [
1887
            title  => 'upper_case',
1888
            author => 'upper_case'
1889
        ]
1890
    );
1891

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

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

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

            
1898
Create column clause. The follwoing column clause is created.
1899

            
1900
    book.author as book__author,
1901
    book.title as book__title
1902

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

            
1905
Get L<DBIx::Custom::Query> object instead of executing SQL.
1906
This is true or false value.
1907

            
1908
    my $query = $dbi->delete(query => 1);
1909

            
1910
You can check SQL.
1911

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1914
=back
1915

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

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

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

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

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

            
1927
    $dbi->delete_at(
1928
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1929
        primary_key => 'id',
1930
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1931
    );
1932

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1941
Primary key. This is constant value or array reference.
1942
    
1943
    # Constant value
1944
    $dbi->delete(primary_key => 'id');
1945

            
1946
    # Array reference
1947
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1948

            
1949
This is used to create where clause.
1950

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

            
1953
Where clause, created from primary key information.
1954
This is constant value or array reference.
1955

            
1956
    # Constant value
1957
    $dbi->delete(where => 5);
1958

            
1959
    # Array reference
1960
    $dbi->delete(where => [3, 5]);
1961

            
1962
In first examle, the following SQL is created.
1963

            
1964
    delete from book where id = ?;
1965

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1972
    $dbi->insert(
1973
        table  => 'book', 
1974
        param  => {title => 'Perl', author => 'Ken'}
1975
    );
1976

            
1977
Insert statement.
1978

            
1979
The following opitons are currently available.
1980

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

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

            
1985
Table name.
1986

            
1987
    $dbi->insert(table => 'book');
1988

            
1989
=item C<param>
1990

            
1991
Insert data. This is hash reference.
1992

            
1993
    $dbi->insert(param => {title => 'Perl'});
1994

            
1995
=item C<append>
1996

            
1997
Append statement to last of SQL. This is string.
1998

            
1999
    $dbi->insert(append => 'order by title');
2000

            
2001
=item C<filter>
2002

            
2003
Filter, executed before data is send to database. This is array reference.
2004
Filter value is code reference or
2005
filter name registerd by C<register_filter()>.
2006

            
2007
    # Basic
2008
    $dbi->insert(
2009
        filter => [
2010
            title  => sub { uc $_[0] }
2011
            author => sub { uc $_[0] }
2012
        ]
2013
    );
2014
    
2015
    # At once
2016
    $dbi->insert(
2017
        filter => [
2018
            [qw/title author/]  => sub { uc $_[0] }
2019
        ]
2020
    );
2021
    
2022
    # Filter name
2023
    $dbi->insert(
2024
        filter => [
2025
            title  => 'upper_case',
2026
            author => 'upper_case'
2027
        ]
2028
    );
2029

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

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

            
2034
Get L<DBIx::Custom::Query> object instead of executing SQL.
2035
This is true or false value.
2036

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

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

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

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

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

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

            
2049
    $dbi->insert_at(
2050
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2051
        primary_key => 'id',
2052
        where => '5',
2053
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2054
    );
2055

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

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

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

            
2064
Primary key. This is constant value or array reference.
2065
    
2066
    # Constant value
2067
    $dbi->insert(primary_key => 'id');
2068

            
2069
    # Array reference
2070
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2071

            
2072
This is used to create parts of insert data.
2073

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

            
2076
Parts of Insert data, create from primary key information.
2077
This is constant value or array reference.
2078

            
2079
    # Constant value
2080
    $dbi->insert(where => 5);
2081

            
2082
    # Array reference
2083
    $dbi->insert(where => [3, 5]);
2084

            
2085
In first examle, the following SQL is created.
2086

            
2087
    insert into book (id, title) values (?, ?);
2088

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2091
=back
2092

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

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

            
2097
Create insert parameter tag.
2098

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2108
    lib / MyModel.pm
2109
        / MyModel / book.pm
2110
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2111

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

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

            
2116
    package MyModel;
2117
    
2118
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2119
    
2120
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2121

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2126
    package MyModel::book;
2127
    
2128
    use base 'MyModel';
2129
    
2130
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2131

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2134
    package MyModel::company;
2135
    
2136
    use base 'MyModel';
2137
    
2138
    1;
2139
    
2140
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2141

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

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

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

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

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

            
2153
Merge paramters.
2154

            
2155
$param:
2156

            
2157
    {key1 => [1, 1], key2 => 2}
2158

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

            
2161
    $dbi->method(
2162
        update_or_insert => sub {
2163
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2164
            
2165
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2166
        },
2167
        find_or_create   => sub {
2168
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2169
            
2170
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2171
        }
2172
    );
2173

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

            
2176
    $dbi->update_or_insert;
2177
    $dbi->find_or_create;
2178

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

            
2181
    $dbi->model('book')->method(
2182
        insert => sub { ... },
2183
        update => sub { ... }
2184
    );
2185
    
2186
    my $model = $dbi->model('book');
2187

            
2188
Set and get a L<DBIx::Custom::Model> object,
2189

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

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

            
2194
Create column clause for myself. The follwoing column clause is created.
2195

            
2196
    book.author as author,
2197
    book.title as title
2198

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2201
    my $dbi = DBIx::Custom->new(
2202
        data_source => "dbi:mysql:database=dbname",
2203
        user => 'ken',
2204
        password => '!LFKD%$&',
2205
        dbi_option => {mysql_enable_utf8 => 1}
2206
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2207

            
2208
Create a new L<DBIx::Custom> object.
2209

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

            
2212
    my $not_exists = $dbi->not_exists;
2213

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2217
=head2 C<register_filter>
2218

            
update pod
Yuki Kimoto authored on 2011-03-13
2219
    $dbi->register_filter(
2220
        # Time::Piece object to database DATE format
2221
        tp_to_date => sub {
2222
            my $tp = shift;
2223
            return $tp->strftime('%Y-%m-%d');
2224
        },
2225
        # database DATE format to Time::Piece object
2226
        date_to_tp => sub {
2227
           my $date = shift;
2228
           return Time::Piece->strptime($date, '%Y-%m-%d');
2229
        }
2230
    );
cleanup
yuki-kimoto authored on 2010-10-17
2231
    
update pod
Yuki Kimoto authored on 2011-03-13
2232
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2233

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2236
    $dbi->register_tag(
2237
        update => sub {
2238
            my @columns = @_;
2239
            
2240
            # Update parameters
2241
            my $s = 'set ';
2242
            $s .= "$_ = ?, " for @columns;
2243
            $s =~ s/, $//;
2244
            
2245
            return [$s, \@columns];
2246
        }
2247
    );
cleanup
yuki-kimoto authored on 2010-10-17
2248

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

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

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

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

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

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

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

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

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
2270
=head2 C<replace> EXPERIMENTAL
2271
    
2272
    my $join = [
2273
        'left outer join table2 on table1.key1 = table2.key1',
2274
        'left outer join table3 on table2.key3 = table3.key3'
2275
    ];
2276
    $join = $dbi->replace(
2277
        $join,
2278
        'left outer join table2 on table1.key1 = table2.key1',
2279
        'left outer join (select * from table2 where {= table2.key1}) ' . 
2280
          'as table2 on table1.key1 = table2.key1'
2281
    );
2282

            
2283
Replace join clauses if match the expression.
2284

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2287
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2288
        table  => 'book',
2289
        column => ['author', 'title'],
2290
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2291
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2292
    
update pod
Yuki Kimoto authored on 2011-03-12
2293
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2294

            
2295
The following opitons are currently available.
2296

            
2297
=over 4
2298

            
2299
=item C<table>
2300

            
2301
Table name.
2302

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

            
2305
=item C<column>
2306

            
2307
Column clause. This is array reference or constant value.
2308

            
2309
    # Hash refernce
2310
    $dbi->select(column => ['author', 'title']);
2311
    
2312
    # Constant value
2313
    $dbi->select(column => 'author');
2314

            
2315
Default is '*' unless C<column> is specified.
2316

            
2317
    # Default
2318
    $dbi->select(column => '*');
2319

            
2320
=item C<where>
2321

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2322
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2323
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2324
    
2325
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2326
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2327
    
update pod
Yuki Kimoto authored on 2011-03-12
2328
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2329
    my $where = $dbi->where(
2330
        clause => ['and', '{= author}', '{like title}'],
2331
        param  => {author => 'Ken', title => '%Perl%'}
2332
    );
update pod
Yuki Kimoto authored on 2011-03-12
2333
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2334

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2335
    # Array refrendce (where clause and parameter)
2336
    $dbi->select(where =>
2337
        [
2338
            ['and', '{= author}', '{like title}'],
2339
            {author => 'Ken', title => '%Perl%'}
2340
        ]
2341
    );
2342
    
update pod
Yuki Kimoto authored on 2011-03-13
2343
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2344

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

            
2347
    $dbi->select(join =>
2348
        [
2349
            'left outer join company on book.company_id = company_id',
2350
            'left outer join location on company.location_id = location.id'
2351
        ]
2352
    );
2353

            
2354
If column cluase or where clause contain table name like "company.name",
2355
needed join clause is used automatically.
2356

            
2357
    $dbi->select(
2358
        table => 'book',
2359
        column => ['company.location_id as company__location_id'],
2360
        where => {'company.name' => 'Orange'},
2361
        join => [
2362
            'left outer join company on book.company_id = company.id',
2363
            'left outer join location on company.location_id = location.id'
2364
        ]
2365
    );
2366

            
2367
In above select, the following SQL is created.
2368

            
2369
    select company.location_id as company__location_id
2370
    from book
2371
      left outer join company on book.company_id = company.id
2372
    where company.name = Orange
2373

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

            
2376
Parameter shown before where clause.
2377
    
2378
    $dbi->select(
2379
        table => 'table1',
2380
        column => 'table1.key1 as table1_key1, key2, key3',
2381
        where   => {'table1.key2' => 3},
2382
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2383
                  ' as table2 on table1.key1 = table2.key1'],
2384
        param => {'table2.key3' => 5}
2385
    );
2386

            
2387
For example, if you want to contain tag in join clause, 
2388
you can pass parameter by C<param> option.
2389

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

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

            
2394
    $dbi->select(append => 'order by title');
2395

            
2396
=item C<filter>
2397

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

            
2402
    # Basic
2403
    $dbi->select(
2404
        filter => [
2405
            title  => sub { uc $_[0] }
2406
            author => sub { uc $_[0] }
2407
        ]
2408
    );
2409
    
2410
    # At once
2411
    $dbi->select(
2412
        filter => [
2413
            [qw/title author/]  => sub { uc $_[0] }
2414
        ]
2415
    );
2416
    
2417
    # Filter name
2418
    $dbi->select(
2419
        filter => [
2420
            title  => 'upper_case',
2421
            author => 'upper_case'
2422
        ]
2423
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2424

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

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

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

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

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

            
2436
    my $sql = $query->sql;
2437

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

            
2440
Specify database data type.
2441

            
2442
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2443
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2444

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

            
2447
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2448

            
update pod
Yuki Kimoto authored on 2011-03-12
2449
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2450

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

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

            
2455
    $dbi->select_at(
2456
        table => 'book',
2457
        primary_key => 'id',
2458
        where => '5'
2459
    );
2460

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2469
Primary key. This is constant value or array reference.
2470
    
2471
    # Constant value
2472
    $dbi->select(primary_key => 'id');
2473

            
2474
    # Array reference
2475
    $dbi->select(primary_key => ['id1', 'id2' ]);
2476

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

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

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

            
2484
    # Constant value
2485
    $dbi->select(where => 5);
2486

            
2487
    # Array reference
2488
    $dbi->select(where => [3, 5]);
2489

            
2490
In first examle, the following SQL is created.
2491

            
2492
    select * from book where id = ?
2493

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2496
=back
2497

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2500
    $dbi->update(
2501
        table  => 'book',
2502
        param  => {title => 'Perl'},
2503
        where  => {id => 4}
2504
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2505

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2514
Table name.
2515

            
2516
    $dbi->update(table => 'book');
2517

            
2518
=item C<param>
2519

            
2520
Update data. This is hash reference.
2521

            
2522
    $dbi->update(param => {title => 'Perl'});
2523

            
2524
=item C<where>
2525

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2526
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2527
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2528
    
2529
    # Hash reference
2530
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2531
    
2532
    # DBIx::Custom::Where object
2533
    my $where = $dbi->where(
2534
        clause => ['and', '{= author}', '{like title}'],
2535
        param  => {author => 'Ken', title => '%Perl%'}
2536
    );
2537
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2538
    
2539
    # Array refrendce (where clause and parameter)
2540
    $dbi->update(where =>
2541
        [
2542
            ['and', '{= author}', '{like title}'],
2543
            {author => 'Ken', title => '%Perl%'}
2544
        ]
2545
    );
update pod
Yuki Kimoto authored on 2011-03-13
2546

            
2547
=item C<append>
2548

            
2549
Append statement to last of SQL. This is string.
2550

            
2551
    $dbi->update(append => 'order by title');
2552

            
2553
=item C<filter>
2554

            
2555
Filter, executed before data is send to database. This is array reference.
2556
Filter value is code reference or
2557
filter name registerd by C<register_filter()>.
2558

            
2559
    # Basic
2560
    $dbi->update(
2561
        filter => [
2562
            title  => sub { uc $_[0] }
2563
            author => sub { uc $_[0] }
2564
        ]
2565
    );
2566
    
2567
    # At once
2568
    $dbi->update(
2569
        filter => [
2570
            [qw/title author/]  => sub { uc $_[0] }
2571
        ]
2572
    );
2573
    
2574
    # Filter name
2575
    $dbi->update(
2576
        filter => [
2577
            title  => 'upper_case',
2578
            author => 'upper_case'
2579
        ]
2580
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2581

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

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

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

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

            
2591
You can check SQL.
2592

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2595
=back
2596

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

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

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

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

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

            
2608
    $dbi->update_at(
2609
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2610
        primary_key => 'id',
2611
        where => '5',
2612
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2613
    );
2614

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

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

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

            
2623
Primary key. This is constant value or array reference.
2624
    
2625
    # Constant value
2626
    $dbi->update(primary_key => 'id');
2627

            
2628
    # Array reference
2629
    $dbi->update(primary_key => ['id1', 'id2' ]);
2630

            
2631
This is used to create where clause.
2632

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

            
2635
Where clause, created from primary key information.
2636
This is constant value or array reference.
2637

            
2638
    # Constant value
2639
    $dbi->update(where => 5);
2640

            
2641
    # Array reference
2642
    $dbi->update(where => [3, 5]);
2643

            
2644
In first examle, the following SQL is created.
2645

            
2646
    update book set title = ? where id = ?
2647

            
2648
Place holders are set to 'Perl' and 5.
2649

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

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

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

            
2656
Create update parameter tag.
2657

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2663
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2664
        {title => 'a', age => 2}
2665
        {no_set => 1}
2666
    );
2667

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2672
    my $where = $dbi->where(
2673
        clause => ['and', '{= title}', '{= author}'],
2674
        param => {title => 'Perl', author => 'Ken'}
2675
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2676

            
2677
Create a new L<DBIx::Custom::Where> object.
2678

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2686
=head1 Tags
2687

            
2688
The following tags is available.
2689

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

            
2692
Table tag
2693

            
2694
    {table TABLE}    ->    TABLE
2695

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2698
=head2 C<?>
2699

            
2700
Placeholder tag.
2701

            
2702
    {? NAME}    ->   ?
2703

            
2704
=head2 C<=>
2705

            
2706
Equal tag.
2707

            
2708
    {= NAME}    ->   NAME = ?
2709

            
2710
=head2 C<E<lt>E<gt>>
2711

            
2712
Not equal tag.
2713

            
2714
    {<> NAME}   ->   NAME <> ?
2715

            
2716
=head2 C<E<lt>>
2717

            
2718
Lower than tag
2719

            
2720
    {< NAME}    ->   NAME < ?
2721

            
2722
=head2 C<E<gt>>
2723

            
2724
Greater than tag
2725

            
2726
    {> NAME}    ->   NAME > ?
2727

            
2728
=head2 C<E<gt>=>
2729

            
2730
Greater than or equal tag
2731

            
2732
    {>= NAME}   ->   NAME >= ?
2733

            
2734
=head2 C<E<lt>=>
2735

            
2736
Lower than or equal tag
2737

            
2738
    {<= NAME}   ->   NAME <= ?
2739

            
2740
=head2 C<like>
2741

            
2742
Like tag
2743

            
2744
    {like NAME}   ->   NAME like ?
2745

            
2746
=head2 C<in>
2747

            
2748
In tag.
2749

            
2750
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2751

            
2752
=head2 C<insert_param>
2753

            
2754
Insert parameter tag.
2755

            
2756
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2757

            
2758
=head2 C<update_param>
2759

            
2760
Updata parameter tag.
2761

            
2762
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2763

            
added environment variable D...
Yuki Kimoto authored on 2011-04-02
2764
=head1 ENVIRONMENT VARIABLE
2765

            
2766
=head2 C<DBIX_CUSTOM_DEBUG>
2767

            
2768
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2769
executed SQL is printed to STDERR.
2770

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

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

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

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

            
2780
C<< <kimoto.yuki at gmail.com> >>
2781

            
2782
L<http://github.com/yuki-kimoto/DBIx-Custom>
2783

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2784
=head1 AUTHOR
2785

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

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

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

            
2792
This program is free software; you can redistribute it and/or modify it
2793
under the same terms as Perl itself.
2794

            
2795
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2796

            
2797