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

            
removed from cache() and cac...
Yuki Kimoto authored on 2011-03-29
3
our $VERSION = '0.1666';
fixed DBIx::Custom::QueryBui...
yuki-kimoto authored on 2010-08-15
4

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

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

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

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

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

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

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

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

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

            
85
    # Initialize filters
cleanup
Yuki Kimoto authored on 2011-01-12
86
    $self->{filter} ||= {};
many changed
Yuki Kimoto authored on 2011-01-23
87
    $self->{filter}{out} ||= {};
88
    $self->{filter}{in} ||= {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
89
    $self->{filter}{end} ||= {};
cleanup
Yuki Kimoto authored on 2010-12-22
90
    
many changed
Yuki Kimoto authored on 2011-01-23
91
    # Create filters
92
    my $usage = "Usage: \$dbi->apply_filter(" .
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
93
                "TABLE, COLUMN1, {in => INFILTER1, out => OUTFILTER1, end => ENDFILTER1}, " .
94
                "COLUMN2, {in => INFILTER2, out => OUTFILTER2, end => ENDFILTER2}, ...)";
many changed
Yuki Kimoto authored on 2011-01-23
95

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
145
sub column {
146
    my ($self, $table, $columns) = @_;
added helper method
yuki-kimoto authored on 2010-10-17
147
    
cleanup
Yuki Kimoto authored on 2011-03-21
148
    $columns ||= [];
added helper method
yuki-kimoto authored on 2010-10-17
149
    
cleanup
Yuki Kimoto authored on 2011-03-21
150
    my @column;
151
    push @column, "$table.$_ as ${table}__$_" for @$columns;
152
    
153
    return join (', ', @column);
added helper method
yuki-kimoto authored on 2010-10-17
154
}
155

            
packaging one directory
yuki-kimoto authored on 2009-11-16
156
sub connect {
cleanup
Yuki Kimoto authored on 2011-01-25
157
    my $self = ref $_[0] ? shift : shift->new(@_);;
removed register_format()
yuki-kimoto authored on 2010-05-26
158
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
159
    my $dbh = $self->_connect;
packaging one directory
yuki-kimoto authored on 2009-11-16
160
    
update document
yuki-kimoto authored on 2010-01-30
161
    # Database handle
packaging one directory
yuki-kimoto authored on 2009-11-16
162
    $self->dbh($dbh);
update document
yuki-kimoto authored on 2010-01-30
163
    
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
164
    # Process ID
165
    $self->pid($$);
166
    
packaging one directory
yuki-kimoto authored on 2009-11-16
167
    return $self;
168
}
169

            
cleanup
yuki-kimoto authored on 2010-10-17
170
sub create_query {
171
    my ($self, $source) = @_;
update document
yuki-kimoto authored on 2010-01-30
172
    
cleanup
yuki-kimoto authored on 2010-10-17
173
    # Cache
174
    my $cache = $self->cache;
update document
yuki-kimoto authored on 2010-01-30
175
    
cleanup
yuki-kimoto authored on 2010-10-17
176
    # Create query
177
    my $query;
178
    if ($cache) {
179
        
180
        # Get query
181
        my $q = $self->cache_method->($self, $source);
182
        
183
        # Create query
add table tag
Yuki Kimoto authored on 2011-02-09
184
        if ($q) {
185
            $query = DBIx::Custom::Query->new($q);
186
            $query->filters($self->filters);
187
        }
cleanup
yuki-kimoto authored on 2010-10-17
188
    }
189
    
190
    unless ($query) {
cleanup insert
yuki-kimoto authored on 2010-04-28
191

            
cleanup
yuki-kimoto authored on 2010-10-17
192
        # Create SQL object
193
        my $builder = $self->query_builder;
194
        
195
        # Create query
196
        $query = $builder->build_query($source);
removed register_format()
yuki-kimoto authored on 2010-05-26
197

            
cleanup
yuki-kimoto authored on 2010-10-17
198
        # Cache query
199
        $self->cache_method->($self, $source,
200
                             {sql     => $query->sql, 
add table tag
Yuki Kimoto authored on 2011-02-09
201
                              columns => $query->columns,
202
                              tables  => $query->tables})
cleanup
yuki-kimoto authored on 2010-10-17
203
          if $cache;
cleanup insert
yuki-kimoto authored on 2010-04-28
204
    }
205
    
cleanup
yuki-kimoto authored on 2010-10-17
206
    # Prepare statement handle
207
    my $sth;
208
    eval { $sth = $self->dbh->prepare($query->{sql})};
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
209
    $self->_croak($@, qq{. Following SQL is executed. "$query->{sql}"}) if $@;
packaging one directory
yuki-kimoto authored on 2009-11-16
210
    
cleanup
yuki-kimoto authored on 2010-10-17
211
    # Set statement handle
212
    $query->sth($sth);
packaging one directory
yuki-kimoto authored on 2009-11-16
213
    
cleanup
Yuki Kimoto authored on 2011-02-09
214
    # Set filters
215
    $query->filters($self->filters);
216
    
cleanup
yuki-kimoto authored on 2010-10-17
217
    return $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
218
}
219

            
update pod
Yuki Kimoto authored on 2011-03-13
220
sub dbh {
221
    my $self = shift;
222

            
223
    if (@_) {
224
        $self->{dbh} = $_[0];
225
        return $self;
226
    }
227
    else {
228
        my $pid = $$;
229
        if ($self->pid eq $pid) {
230
            return $self->{dbh};
231
        }
232
        else {
233
            # Create new connection in child process
234
            croak "Process is forked in transaction"
235
              unless $self->{dbh}->{AutoCommit};
236
            $self->pid($pid);
237
            $self->{dbh}->{InactiveDestroy} = 1;
238
            return $self->{dbh} = $self->_connect;
239
        }
240
    }
241
}
242

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

            
cleanup
yuki-kimoto authored on 2010-10-17
246
sub delete {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
247
    my ($self, %args) = @_;
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
248
    
cleanup
Yuki Kimoto authored on 2011-03-09
249
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
250
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
251
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
252
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
253
    }
254
    
255
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
256
    my $table = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
257
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
258
    my $where            = delete $args{where} || {};
259
    my $append           = delete $args{append};
260
    my $allow_delete_all = delete $args{allow_delete_all};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
261

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
262
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
263
    my $w = $self->_where($where);
264
    $where = $w->param;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
265
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
266
    # String where
267
    my $swhere = "$w";
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
268
    
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
269
    croak qq{"where" must be specified}
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
270
      if $swhere eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
271

            
cleanup
Yuki Kimoto authored on 2011-01-27
272
    # SQL stack
273
    my @sql;
274

            
275
    # Delete
276
    push @sql, "delete from $table $swhere";
277
    push @sql, $append if $append;
278
    
279
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
280
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
281
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
282
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
283
    return $query if $args{query};
284
    
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
286
    my $ret_val = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
287
        $query,
288
        param  => $where,
289
        table => $table,
290
        %args
291
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
292
    
293
    return $ret_val;
294
}
295

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

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

            
300
sub delete_at {
301
    my ($self, %args) = @_;
302
    
cleanup
Yuki Kimoto authored on 2011-03-09
303
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
304
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
305
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
306
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
307
    }
308
    
309
    # Primary key
310
    my $primary_keys = delete $args{primary_key};
311
    $primary_keys = [$primary_keys] unless ref $primary_keys;
312
    
313
    # Where clause
314
    my $where = {};
315
    if (exists $args{where}) {
316
        my $where_columns = delete $args{where};
317
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
318

            
319
        croak qq{"where" must be constant value or array reference}
320
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
321
        
322
        for(my $i = 0; $i < @$primary_keys; $i ++) {
323
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
324
        }
325
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
326
    
327
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
328
        my $param = delete $args{param};
329
        
330
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
331
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
332
        }
333
    }
334
    
335
    return $self->delete(where => $where, %args);
336
}
337

            
added helper method
yuki-kimoto authored on 2010-10-17
338
sub DESTROY { }
339

            
cleanup
Yuki Kimoto authored on 2011-03-21
340
our %EXECUTE_ARGS = map { $_ => 1 } @COMMON_ARGS, 'param';
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
341

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
396
sub execute{
397
    my ($self, $query, %args)  = @_;
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
398
    
cleanup
Yuki Kimoto authored on 2011-03-09
399
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
400
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
401
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
402
          unless $EXECUTE_ARGS{$name};
refactoring delete and delet...
yuki-kimoto authored on 2010-04-28
403
    }
404
    
cleanup
yuki-kimoto authored on 2010-10-17
405
    my $params = $args{param} || {};
packaging one directory
yuki-kimoto authored on 2009-11-16
406
    
cleanup
yuki-kimoto authored on 2010-10-17
407
    # First argument is the soruce of SQL
408
    $query = $self->create_query($query)
409
      unless ref $query;
packaging one directory
yuki-kimoto authored on 2009-11-16
410
    
add table tag
Yuki Kimoto authored on 2011-02-09
411
    # Applied filter
cleanup
Yuki Kimoto authored on 2011-01-12
412
    my $filter = {};
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
413
    
add table tag
Yuki Kimoto authored on 2011-02-09
414
    my $tables = $query->tables;
415
    my $arg_tables = $args{table} || [];
416
    $arg_tables = [$arg_tables]
417
      unless ref $arg_tables eq 'ARRAY';
418
    push @$tables, @$arg_tables;
cleanup
Yuki Kimoto authored on 2011-03-09
419

            
420
    # Organize tables
421
    my %table_set = map {defined $_ ? ($_ => 1) : ()} @$tables;
422
    my $main_table = pop @$tables;
423
    delete $table_set{$main_table} if $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
424
    foreach my $table (keys %table_set) {
425
        push @$tables, $table;
426
        
427
        if (my $dist = $self->{_table_alias}->{$table}) {
428
            $self->{filter} ||= {};
429
            
430
            unless ($self->{filter}{out}{$table}) {
431
                $self->{filter}{out} ||= {};
432
                $self->{filter}{in}  ||= {};
433
                $self->{filter}{end} ||= {};
434
                
435
                foreach my $type (qw/out in end/) {
436
                    
437
                    foreach my $filter_name (keys %{$self->{filter}{$type}{$dist} || {}}) {
438
                        my $filter_name_alias = $filter_name;
439
                        $filter_name_alias =~ s/^$dist\./$table\./;
440
                        $filter_name_alias =~ s/^${dist}__/${table}__/; 
441
                        
442
                        $self->{filter}{$type}{$table}{$filter_name_alias}
443
                          = $self->{filter}{$type}{$dist}{$filter_name}
444
                    }
445
                }
446
            }
447
        }
448
    }
449
    
cleanup
Yuki Kimoto authored on 2011-03-09
450
    $tables = [keys %table_set];
451
    push @$tables, $main_table if $main_table;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
452
    
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
453
    foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
454
        next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
455
        $filter = {
456
            %$filter,
457
            %{$self->{filter}{out}->{$table} || {}}
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
458
        }
459
    }
460
    
cleanup
Yuki Kimoto authored on 2011-01-12
461
    # Filter argument
cleanup
Yuki Kimoto authored on 2011-03-21
462
    my $f = DBIx::Custom::Util::array_to_hash($args{filter})
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
463
         || $query->filter || {};
cleanup
Yuki Kimoto authored on 2011-01-12
464
    foreach my $column (keys %$f) {
465
        my $fname = $f->{$column};
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
466
        if (!defined $fname) {
cleanup
Yuki Kimoto authored on 2011-01-12
467
            $f->{$column} = undef;
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
468
        }
469
        elsif (ref $fname ne 'CODE') {
many changed
Yuki Kimoto authored on 2011-01-23
470
          croak qq{Filter "$fname" is not registered"}
cleanup
Yuki Kimoto authored on 2010-12-21
471
            unless exists $self->filters->{$fname};
472
          
cleanup
Yuki Kimoto authored on 2011-01-12
473
          $f->{$column} = $self->filters->{$fname};
cleanup
Yuki Kimoto authored on 2010-12-21
474
        }
475
    }
cleanup
Yuki Kimoto authored on 2011-01-12
476
    $filter = {%$filter, %$f};
packaging one directory
yuki-kimoto authored on 2009-11-16
477
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
478
    # Type
479
    my $type = DBIx::Custom::Util::array_to_hash($args{type});
480
    
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
481
    # Bind
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
482
    my $bind = $self->_bind($params, $query->columns, $filter, $type);
cleanup
yuki-kimoto authored on 2010-10-17
483
    
484
    # Execute
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
485
    my $sth = $query->sth;
cleanup
yuki-kimoto authored on 2010-10-17
486
    my $affected;
cleanup
Yuki Kimoto authored on 2011-03-21
487
    eval {
488
        for (my $i = 0; $i < @$bind; $i++) {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
489
            if (my $type = $bind->[$i]->{type}) {
490
                $sth->bind_param($i + 1, $bind->[$i]->{value}, $type);
491
            }
492
            else {
493
                $sth->bind_param($i + 1, $bind->[$i]->{value});
494
            }
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
    
500
    # Return resultset if select statement is executed
501
    if ($sth->{NUM_OF_FIELDS}) {
502
        
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
503
        # Result in and end filter
504
        my $in_filter  = {};
505
        my $end_filter = {};
cleanup
Yuki Kimoto authored on 2011-01-12
506
        foreach my $table (@$tables) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
507
            next unless $table;
cleanup
Yuki Kimoto authored on 2011-01-12
508
            $in_filter = {
509
                %$in_filter,
510
                %{$self->{filter}{in}{$table} || {}}
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
511
            };
512
            $end_filter = {
513
                %$end_filter,
514
                %{$self->{filter}{end}{$table} || {}}
515
            };
cleanup
Yuki Kimoto authored on 2011-01-12
516
        }
517
        
518
        # Result
519
        my $result = $self->result_class->new(
cleanup
Yuki Kimoto authored on 2010-12-22
520
            sth            => $sth,
521
            filters        => $self->filters,
522
            filter_check   => $self->filter_check,
cleanup
Yuki Kimoto authored on 2011-01-12
523
            default_filter => $self->{default_in_filter},
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
524
            filter         => $in_filter || {},
525
            end_filter     => $end_filter || {}
cleanup
yuki-kimoto authored on 2010-10-17
526
        );
527

            
528
        return $result;
529
    }
530
    return $affected;
531
}
532

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

            
cleanup
yuki-kimoto authored on 2010-10-17
535
sub insert {
536
    my ($self, %args) = @_;
537

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

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

            
586
sub insert_at {
587
    my ($self, %args) = @_;
588
    
cleanup
Yuki Kimoto authored on 2011-03-09
589
    # Check argument names
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
590
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
591
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
592
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
593
    }
594
    
595
    # Primary key
596
    my $primary_keys = delete $args{primary_key};
597
    $primary_keys = [$primary_keys] unless ref $primary_keys;
598
    
599
    # Where clause
600
    my $where = {};
601
    my $param = {};
602
    
603
    if (exists $args{where}) {
604
        my $where_columns = delete $args{where};
605
        $where_columns = [$where_columns] unless ref $where_columns;
606

            
607
        croak qq{"where" must be constant value or array reference}
608
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
609
        
610
        for(my $i = 0; $i < @$primary_keys; $i ++) {
611
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
612
        }
613
    }
614
    
615
    if (exists $args{param}) {
616
        $param = delete $args{param};
617
        for(my $i = 0; $i < @$primary_keys; $i ++) {
618
             delete $param->{$primary_keys->[$i]};
619
        }
620
    }
621
    
622
    $param = {%$param, %$where};
623
    
624
    return $self->insert(param => $param, %args);
625
}
626

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
627
sub insert_param {
628
    my ($self, $param) = @_;
629
    
update pod
Yuki Kimoto authored on 2011-03-13
630
    # Insert parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
631
    my @tag;
632
    push @tag, '{insert_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
633
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
634
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
635
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
636
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
637
        push @tag, $column;
638
    }
639
    push @tag, '}';
640
    
641
    return join ' ', @tag;
642
}
643

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
707
sub method {
708
    my $self = shift;
709
    
710
    # Merge
711
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
712
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
713
    
714
    return $self;
715
}
716

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
717
sub model {
718
    my ($self, $name, $model) = @_;
719
    
720
    # Set
721
    if ($model) {
722
        $self->models->{$name} = $model;
723
        return $self;
724
    }
725
    
726
    # Check model existance
727
    croak qq{Model "$name" is not included}
728
      unless $self->models->{$name};
729
    
730
    # Get
731
    return $self->models->{$name};
732
}
733

            
cleanup
Yuki Kimoto authored on 2011-03-21
734
sub mycolumn {
735
    my ($self, $table, $columns) = @_;
736
    
737
    $columns ||= [];
738
    my @column;
739
    push @column, "$table.$_ as $_" for @$columns;
740
    
741
    return join (', ', @column);
742
}
743

            
added dbi_options attribute
kimoto authored on 2010-12-20
744
sub new {
745
    my $self = shift->SUPER::new(@_);
746
    
747
    # Check attribute names
748
    my @attrs = keys %$self;
749
    foreach my $attr (@attrs) {
750
        croak qq{"$attr" is invalid attribute name}
751
          unless $self->can($attr);
752
    }
cleanup
Yuki Kimoto authored on 2011-01-25
753

            
754
    $self->register_tag(
755
        '?'     => \&DBIx::Custom::Tag::placeholder,
756
        '='     => \&DBIx::Custom::Tag::equal,
757
        '<>'    => \&DBIx::Custom::Tag::not_equal,
758
        '>'     => \&DBIx::Custom::Tag::greater_than,
759
        '<'     => \&DBIx::Custom::Tag::lower_than,
760
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
761
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
762
        'like'  => \&DBIx::Custom::Tag::like,
763
        'in'    => \&DBIx::Custom::Tag::in,
764
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
765
        'update_param' => \&DBIx::Custom::Tag::update_param
766
    );
added dbi_options attribute
kimoto authored on 2010-12-20
767
    
768
    return $self;
769
}
770

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

            
cleanup
yuki-kimoto authored on 2010-10-17
773
sub register_filter {
774
    my $invocant = shift;
775
    
776
    # Register filter
777
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
778
    $invocant->filters({%{$invocant->filters}, %$filters});
779
    
780
    return $invocant;
781
}
packaging one directory
yuki-kimoto authored on 2009-11-16
782

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
785
our %SELECT_ARGS
cleanup
Yuki Kimoto authored on 2011-03-21
786
  = map { $_ => 1 } @COMMON_ARGS, qw/column where append relation
787
                                     selection join/;
refactoring select
yuki-kimoto authored on 2010-04-28
788

            
packaging one directory
yuki-kimoto authored on 2009-11-16
789
sub select {
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
790
    my ($self, %args) = @_;
packaging one directory
yuki-kimoto authored on 2009-11-16
791
    
cleanup
Yuki Kimoto authored on 2011-03-09
792
    # Check argument names
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
793
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
794
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
795
          unless $SELECT_ARGS{$name};
refactoring select
yuki-kimoto authored on 2010-04-28
796
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
797
    
refactoring select
yuki-kimoto authored on 2010-04-28
798
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
799
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
800
    my $tables = ref $table eq 'ARRAY' ? $table
801
               : defined $table ? [$table]
802
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
803
    my $columns   = delete $args{column};
804
    my $selection = delete $args{selection} || '';
805
    my $where     = delete $args{where} || {};
806
    my $append    = delete $args{append};
807
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
808
    croak qq{"join" must be array reference}
809
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
810
    my $relation = delete $args{relation};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
811
    
cleanup
Yuki Kimoto authored on 2011-03-09
812
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
813
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
814
    
cleanup
Yuki Kimoto authored on 2011-01-27
815
    # SQL stack
816
    my @sql;
817
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
818
    
cleanup
Yuki Kimoto authored on 2011-03-09
819
    # Selection
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
820
    if ($selection) { 
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
821
        push @sql, $selection;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
822
        if ($selection =~ /from\s+(?:\{table\s+)?([^\s\{]+?)\b/) {
823
             unshift @$tables, $1;
824
        }
825
        unshift @$tables, @{$self->_tables($selection)};
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
826
    }
cleanup
Yuki Kimoto authored on 2011-03-09
827
    
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
828
    # Column clause
829
    elsif ($columns) {
830

            
831
        $columns = [$columns] if ! ref $columns;
832
        
833
        if (ref $columns eq 'HASH') {
834
            # Find tables
835
            my $main_table;
836
            my %tables;
837
            if ($columns->{table}) {
838
                foreach my $table (@{$columns->{table}}) {
839
                    if (($table || '') eq $tables->[-1]) {
840
                        $main_table = $table;
841
                    }
842
                    else {
843
                        $tables{$table} = 1;
844
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
845
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
846
            }
847
            elsif ($columns->{all}) {
848
                $main_table = $tables->[-1] || '';
849
                foreach my $j (@$join) {
850
                    my $tables = $self->_tables($j);
851
                    foreach my $table (@$tables) {
852
                        $tables{$table} = 1;
853
                    }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
854
                }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
855
                delete $tables{$main_table};
856
            }
857
            
858
            push @sql, $columns->{prepend} if $columns->{prepend};
859
            
860
            # Column clause of main table
861
            if ($main_table) {
cleanup
Yuki Kimoto authored on 2011-03-21
862
                push @sql, $self->model($main_table)->mycolumn;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
863
                push @sql, ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
864
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
865
            
866
            # Column cluase of other tables
867
            foreach my $table (keys %tables) {
868
                unshift @$tables, $table;
cleanup
Yuki Kimoto authored on 2011-03-21
869
                push @sql, $self->model($table)->column($table);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
870
                push @sql, ',';
871
            }
872
            pop @sql if $sql[-1] eq ',';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
873
        }
874
        else {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
875
            foreach my $column (@$columns) {
876
                unshift @$tables, @{$self->_tables($column)};
877
                push @sql, ($column, ',');
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
878
            }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
879
            pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
880
        }
881
    }
882
    
883
    # "*" is default
884
    else { push @sql, '*' }
885
    
886
    # Table
887
    unless ($selection) {
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
888
        push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-03-21
889
        if ($relation) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
890
            my $found = {};
891
            foreach my $table (@$tables) {
892
                push @sql, ($table, ',') unless $found->{$table};
893
                $found->{$table} = 1;
894
            }
packaging one directory
yuki-kimoto authored on 2009-11-16
895
        }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
896
        else {
897
            my $main_table = $tables->[-1] || '';
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
898
            push @sql, $main_table;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
899
        }
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
900
        pop @sql if ($sql[-1] || '') eq ',';
packaging one directory
yuki-kimoto authored on 2009-11-16
901
    }
902
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
903
    # Main table
904
    croak "Not found table name" unless $tables->[-1];
905
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
906
    # Where
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
907
    my $w = $self->_where($where);
908
    $where = $w->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
909
    
910
    # String where
911
    my $swhere = "$w";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
912
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
913
    # Add table names in where clause
914
    unshift @$tables, @{$self->_tables($swhere)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
915
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
916
    # Push join
917
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
918
    
cleanup
Yuki Kimoto authored on 2011-03-09
919
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-01-27
920
    push @sql, $swhere;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
921
    
cleanup
Yuki Kimoto authored on 2011-03-08
922
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
923
    $self->_push_relation(\@sql, $tables, $relation, $swhere eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
924
    
cleanup
Yuki Kimoto authored on 2011-01-27
925
    # Append statement
926
    push @sql, $append if $append;
927
    
928
    # SQL
929
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
930
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
931
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
932
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
933
    return $query if $args{query};
934
    
packaging one directory
yuki-kimoto authored on 2009-11-16
935
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
936
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
937
        $query,
938
        param  => $where, 
939
        table => $tables,
940
        %args
941
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
942
    
943
    return $result;
944
}
945

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

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

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
990
sub setup_model {
991
    my $self = shift;
992
    
993
    $self->each_column(
994
        sub {
995
            my ($self, $table, $column, $column_info) = @_;
996
            
997
            if (my $model = $self->models->{$table}) {
998
                push @{$model->columns}, $column;
999
            }
1000
        }
1001
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
1002
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
1003
}
1004

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

            
1008
sub update {
1009
    my ($self, %args) = @_;
version 0.0901
yuki-kimoto authored on 2009-12-17
1010
    
cleanup
Yuki Kimoto authored on 2011-03-09
1011
    # Check argument names
cleanup
yuki-kimoto authored on 2010-10-17
1012
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1013
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1014
          unless $UPDATE_ARGS{$name};
removed reconnect method
yuki-kimoto authored on 2010-05-28
1015
    }
added cache_method attribute
yuki-kimoto authored on 2010-06-25
1016
    
cleanup
yuki-kimoto authored on 2010-10-17
1017
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
1018
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
1019
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
1020
    my $param            = delete $args{param} || {};
1021
    my $where            = delete $args{where} || {};
1022
    my $append           = delete $args{append} || '';
1023
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
1024
    
cleanup
yuki-kimoto authored on 2010-10-17
1025
    # Update keys
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1026
    my @clumns = keys %$param;
1027

            
1028
    # Columns
1029
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1030
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1031
    foreach my $column (keys %$param) {
1032
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1033
          unless $column =~ /^[$safety\.]+$/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1034
        push @columns, $column;
1035
    }
1036
        
cleanup
yuki-kimoto authored on 2010-10-17
1037
    # Update clause
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1038
    my $update_clause = '{update_param ' . join(' ', @clumns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
1039

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

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

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

            
1093
sub update_at {
1094
    my ($self, %args) = @_;
1095
    
cleanup
Yuki Kimoto authored on 2011-03-09
1096
    # Check argument names
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1097
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-03-09
1098
        croak qq{Argument "$name" is invalid name}
cleanup
Yuki Kimoto authored on 2011-03-21
1099
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1100
    }
1101
    
1102
    # Primary key
1103
    my $primary_keys = delete $args{primary_key};
1104
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1105
    
1106
    # Where clause
1107
    my $where = {};
1108
    my $param = {};
1109
    
1110
    if (exists $args{where}) {
1111
        my $where_columns = delete $args{where};
1112
        $where_columns = [$where_columns] unless ref $where_columns;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1113

            
1114
        croak qq{"where" must be constant value or array reference}
1115
          unless !ref $where_columns || ref $where_columns eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1116
        
1117
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1118
           $where->{$primary_keys->[$i]} = $where_columns->[$i];
1119
        }
1120
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1121
    
1122
    if (exists $args{param}) {
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1123
        $param = delete $args{param};
1124
        for(my $i = 0; $i < @$primary_keys; $i ++) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1125
            delete $param->{$primary_keys->[$i]};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1126
        }
1127
    }
1128
    
1129
    return $self->update(where => $where, param => $param, %args);
1130
}
1131

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1132
sub update_param {
1133
    my ($self, $param) = @_;
1134
    
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1135
    # Update parameter tag
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1136
    my @tag;
1137
    push @tag, '{update_param';
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1138
    my $safety = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1139
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1140
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1141
          unless $column =~ /^[$safety\.]+$/;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1142
        push @tag, $column;
1143
    }
1144
    push @tag, '}';
1145
    
1146
    return join ' ', @tag;
1147
}
1148

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

            
1152
    return DBIx::Custom::Where->new(
1153
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1154
        safety_character => $self->safety_character,
cleanup
Yuki Kimoto authored on 2011-03-09
1155
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1156
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1157
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1158

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

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1206
sub _connect {
1207
    my $self = shift;
1208
    
1209
    # Attributes
1210
    my $data_source = $self->data_source;
1211
    croak qq{"data_source" must be specified to connect()"}
1212
      unless $data_source;
1213
    my $user        = $self->user;
1214
    my $password    = $self->password;
1215
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1216
    
1217
    # Connect
1218
    my $dbh = eval {DBI->connect(
1219
        $data_source,
1220
        $user,
1221
        $password,
1222
        {
1223
            %{$self->default_dbi_option},
1224
            %$dbi_option
1225
        }
1226
    )};
1227
    
1228
    # Connect error
1229
    croak $@ if $@;
1230
    
1231
    return $dbh;
1232
}
1233

            
cleanup
yuki-kimoto authored on 2010-10-17
1234
sub _croak {
1235
    my ($self, $error, $append) = @_;
1236
    $append ||= "";
1237
    
1238
    # Verbose
1239
    if ($Carp::Verbose) { croak $error }
1240
    
1241
    # Not verbose
1242
    else {
1243
        
1244
        # Remove line and module infromation
1245
        my $at_pos = rindex($error, ' at ');
1246
        $error = substr($error, 0, $at_pos);
1247
        $error =~ s/\s+$//;
1248
        
1249
        croak "$error$append";
1250
    }
1251
}
1252

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1253
sub _need_tables {
1254
    my ($self, $tree, $need_tables, $tables) = @_;
1255
    
1256
    foreach my $table (@$tables) {
1257
        
1258
        if ($tree->{$table}) {
1259
            $need_tables->{$table} = 1;
1260
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1261
        }
1262
    }
1263
}
1264

            
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1265
sub _tables {
1266
    my ($self, $source) = @_;
1267
    
1268
    my $tables = [];
1269
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1270
    my $safety_character = $self->safety_character;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1271
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1272
    while ($source =~ /\b($safety_character+)\./g) {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1273
        push @$tables, $1;
1274
    }
1275
    
1276
    return $tables;
1277
}
1278

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1279
sub _push_join {
1280
    my ($self, $sql, $join, $join_tables) = @_;
1281
    
1282
    return unless @$join;
1283
    
1284
    my $tree = {};
1285
    
1286
    for (my $i = 0; $i < @$join; $i++) {
1287
        
1288
        my $join_clause = $join->[$i];
1289
        
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
1290
        if ($join_clause =~ /\s([^\.\s]+?)\..+\s([^\.\s]+?)\..+?$/) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1291
            
1292
            my $table1 = $1;
1293
            my $table2 = $2;
1294
            
1295
            croak qq{right side table of "$join_clause" must be uniq}
1296
              if exists $tree->{$table2};
1297
            
1298
            $tree->{$table2}
1299
              = {position => $i, parent => $table1, join => $join_clause};
1300
        }
1301
        else {
1302
            croak qq{join "$join_clause" must be two table name};
1303
        }
1304
    }
1305
    
1306
    my $need_tables = {};
1307
    $self->_need_tables($tree, $need_tables, $join_tables);
1308
    
1309
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-03-08
1310

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1311
    foreach my $need_table (@need_tables) {
1312
        push @$sql, $tree->{$need_table}{join};
1313
    }
1314
}
cleanup
Yuki Kimoto authored on 2011-03-08
1315

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1316
sub _where {
1317
    my ($self, $where) = @_;
1318
    
1319
    my $w;
1320
    if (ref $where eq 'HASH') {
1321
        my $clause = ['and'];
1322
        push @$clause, "{= $_}" for keys %$where;
1323
        $w = $self->where(clause => $clause, param => $where);
1324
    }
1325
    elsif (ref $where eq 'DBIx::Custom::Where') {
1326
        $w = $where;
1327
    }
1328
    elsif (ref $where eq 'ARRAY') {
1329
        $w = $self->where(
1330
            clause => $where->[0],
1331
            param  => $where->[1]
1332
        );
1333
    }
1334
    
1335
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1336
          qq{or array reference, which contains where clause and paramter}
1337
      unless ref $w eq 'DBIx::Custom::Where';
1338
    
1339
    return $w;
1340
}
1341

            
cleanup
Yuki Kimoto authored on 2011-01-25
1342
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1343
__PACKAGE__->attr(
1344
    dbi_options => sub { {} },
1345
    filter_check  => 1
1346
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1347

            
cleanup
Yuki Kimoto authored on 2011-01-25
1348
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1349
sub default_bind_filter {
1350
    my $self = shift;
1351
    
1352
    if (@_) {
1353
        my $fname = $_[0];
1354
        
1355
        if (@_ && !$fname) {
1356
            $self->{default_out_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_out_filter} = $self->filters->{$fname};
1363
        }
1364
        return $self;
1365
    }
1366
    
1367
    return $self->{default_out_filter};
1368
}
1369

            
cleanup
Yuki Kimoto authored on 2011-01-25
1370
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1371
sub default_fetch_filter {
1372
    my $self = shift;
1373
    
1374
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1375
        my $fname = $_[0];
1376

            
cleanup
Yuki Kimoto authored on 2011-01-12
1377
        if (@_ && !$fname) {
1378
            $self->{default_in_filter} = undef;
1379
        }
1380
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1381
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1382
              unless exists $self->filters->{$fname};
1383
        
1384
            $self->{default_in_filter} = $self->filters->{$fname};
1385
        }
1386
        
1387
        return $self;
1388
    }
1389
    
many changed
Yuki Kimoto authored on 2011-01-23
1390
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1391
}
1392

            
cleanup
Yuki Kimoto authored on 2011-01-25
1393
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1394
sub register_tag_processor {
1395
    return shift->query_builder->register_tag_processor(@_);
1396
}
1397

            
cleanup
Yuki Kimoto authored on 2011-03-08
1398
# DEPRECATED!
1399
sub _push_relation {
1400
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1401
    
1402
    if (keys %{$relation || {}}) {
1403
        push @$sql, $need_where ? 'where' : 'and';
1404
        foreach my $rcolumn (keys %$relation) {
1405
            my $table1 = (split (/\./, $rcolumn))[0];
1406
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1407
            push @$tables, ($table1, $table2);
1408
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1409
        }
1410
    }
1411
    pop @$sql if $sql->[-1] eq 'and';    
1412
}
1413

            
1414
# DEPRECATED!
1415
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1416
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1417
    
1418
    if (keys %{$relation || {}}) {
1419
        foreach my $rcolumn (keys %$relation) {
1420
            my $table1 = (split (/\./, $rcolumn))[0];
1421
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1422
            my $table1_exists;
1423
            my $table2_exists;
1424
            foreach my $table (@$tables) {
1425
                $table1_exists = 1 if $table eq $table1;
1426
                $table2_exists = 1 if $table eq $table2;
1427
            }
1428
            unshift @$tables, $table1 unless $table1_exists;
1429
            unshift @$tables, $table2 unless $table2_exists;
1430
        }
1431
    }
1432
}
1433

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1436
=head1 NAME
1437

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

            
1440
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1441

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1442
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1443
    
1444
    # Connect
1445
    my $dbi = DBIx::Custom->connect(
1446
        data_source => "dbi:mysql:database=dbname",
1447
        user => 'ken',
1448
        password => '!LFKD%$&',
1449
        dbi_option => {mysql_enable_utf8 => 1}
1450
    );
cleanup
yuki-kimoto authored on 2010-08-05
1451

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1452
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1453
    $dbi->insert(
1454
        table  => 'book',
1455
        param  => {title => 'Perl', author => 'Ken'}
1456
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1457
    
1458
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1459
    $dbi->update(
1460
        table  => 'book', 
1461
        param  => {title => 'Perl', author => 'Ken'}, 
1462
        where  => {id => 5},
1463
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1464
    
1465
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1466
    $dbi->delete(
1467
        table  => 'book',
1468
        where  => {author => 'Ken'},
1469
    );
cleanup
yuki-kimoto authored on 2010-08-05
1470

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

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

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

            
1509
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1510

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1515
There are many basic methods to execute various queries.
1516
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1517
C<delete_all()>, C<select()>,
1518
C<insert_at()>, C<update_at()>, 
1519
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1520

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1521
=item *
1522

            
1523
Filter when data is send or receive.
1524

            
1525
=item *
1526

            
1527
Data filtering system
1528

            
1529
=item *
1530

            
1531
Model support.
1532

            
1533
=item *
1534

            
1535
Generate where clause dinamically.
1536

            
1537
=item *
1538

            
1539
Generate join clause dinamically.
1540

            
1541
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1542

            
1543
=head1 GUIDE
1544

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

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

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

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

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

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

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

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

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

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

            
1568
=head2 C<default_dbi_option>
1569

            
1570
    my $default_dbi_option = $dbi->default_dbi_option;
1571
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1572

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1576
    {
1577
        RaiseError => 1,
1578
        PrintError => 0,
1579
        AutoCommit => 1,
1580
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1581

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

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

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

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

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

            
1594
    my $models = $dbi->models;
1595
    $dbi       = $dbi->models(\%models);
1596

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1599
=head2 C<password>
1600

            
1601
    my $password = $dbi->password;
1602
    $dbi         = $dbi->password('lkj&le`@s');
1603

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1672
You can set multiple filters at once.
1673

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

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

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

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

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

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

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

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

            
1718
   $dbi->model('book')->select(...);
1719

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

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

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

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

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

            
1736
    my $dbh = $dbi->dbh;
1737
    $dbi    = $dbi->dbh($dbh);
1738

            
1739
Get and set database handle of L<DBI>.
1740

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

            
1743
=head2 C<each_column>
1744

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

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

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

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

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

            
1773
Tag is turned into the statement containing place holder
1774
before SQL is executed.
1775

            
1776
    select * from where title = ? and author like ?;
1777

            
1778
See also L<Tags/Tags>.
1779

            
1780
The following opitons are currently available.
1781

            
1782
=over 4
1783

            
1784
=item C<filter>
1785

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

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

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

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

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

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

            
1824
Delete statement.
1825

            
1826
The following opitons are currently available.
1827

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

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

            
1832
Table name.
1833

            
1834
    $dbi->delete(table => 'book');
1835

            
1836
=item C<where>
1837

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

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

            
1861
Append statement to last of SQL. This is string.
1862

            
1863
    $dbi->delete(append => 'order by title');
1864

            
1865
=item C<filter>
1866

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

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

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

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

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

            
1900
Create column clause. The follwoing column clause is created.
1901

            
1902
    book.author as book__author,
1903
    book.title as book__title
1904

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

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

            
1910
    my $query = $dbi->delete(query => 1);
1911

            
1912
You can check SQL.
1913

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1916
=back
1917

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

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

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

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

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

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

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

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

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

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

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

            
1951
This is used to create where clause.
1952

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

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

            
1958
    # Constant value
1959
    $dbi->delete(where => 5);
1960

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

            
1964
In first examle, the following SQL is created.
1965

            
1966
    delete from book where id = ?;
1967

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1970
=back
1971

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

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

            
1979
Insert statement.
1980

            
1981
The following opitons are currently available.
1982

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

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

            
1987
Table name.
1988

            
1989
    $dbi->insert(table => 'book');
1990

            
1991
=item C<param>
1992

            
1993
Insert data. This is hash reference.
1994

            
1995
    $dbi->insert(param => {title => 'Perl'});
1996

            
1997
=item C<append>
1998

            
1999
Append statement to last of SQL. This is string.
2000

            
2001
    $dbi->insert(append => 'order by title');
2002

            
2003
=item C<filter>
2004

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2045
=back
2046

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

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

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

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

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

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

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

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

            
2074
This is used to create parts of insert data.
2075

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

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

            
2081
    # Constant value
2082
    $dbi->insert(where => 5);
2083

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

            
2087
In first examle, the following SQL is created.
2088

            
2089
    insert into book (id, title) values (?, ?);
2090

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2093
=back
2094

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2095
=head2 C<insert_param>
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2096

            
2097
    my $insert_param = $dbi->insert_param({title => 'a', age => 2});
2098

            
2099
Create insert parameter tag.
2100

            
update pod
Yuki Kimoto authored on 2011-03-13
2101
    {insert_param title age}
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2102

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2151
=head2 C<method> EXPERIMENTAL
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2152

            
2153
    $dbi->method(
2154
        update_or_insert => sub {
2155
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2156
            
2157
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2158
        },
2159
        find_or_create   => sub {
2160
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2161
            
2162
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2163
        }
2164
    );
2165

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

            
2168
    $dbi->update_or_insert;
2169
    $dbi->find_or_create;
2170

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

            
2173
    $dbi->model('book')->method(
2174
        insert => sub { ... },
2175
        update => sub { ... }
2176
    );
2177
    
2178
    my $model = $dbi->model('book');
2179

            
2180
Set and get a L<DBIx::Custom::Model> object,
2181

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

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

            
2186
Create column clause for myself. The follwoing column clause is created.
2187

            
2188
    book.author as author,
2189
    book.title as title
2190

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2193
    my $dbi = DBIx::Custom->new(
2194
        data_source => "dbi:mysql:database=dbname",
2195
        user => 'ken',
2196
        password => '!LFKD%$&',
2197
        dbi_option => {mysql_enable_utf8 => 1}
2198
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2199

            
2200
Create a new L<DBIx::Custom> object.
2201

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

            
2204
    my $not_exists = $dbi->not_exists;
2205

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2209
=head2 C<register_filter>
2210

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2228
    $dbi->register_tag(
2229
        update => sub {
2230
            my @columns = @_;
2231
            
2232
            # Update parameters
2233
            my $s = 'set ';
2234
            $s .= "$_ = ?, " for @columns;
2235
            $s =~ s/, $//;
2236
            
2237
            return [$s, \@columns];
2238
        }
2239
    );
cleanup
yuki-kimoto authored on 2010-10-17
2240

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2264
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2265
        table  => 'book',
2266
        column => ['author', 'title'],
2267
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2268
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2269
    
update pod
Yuki Kimoto authored on 2011-03-12
2270
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2271

            
2272
The following opitons are currently available.
2273

            
2274
=over 4
2275

            
2276
=item C<table>
2277

            
2278
Table name.
2279

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

            
2282
=item C<column>
2283

            
2284
Column clause. This is array reference or constant value.
2285

            
2286
    # Hash refernce
2287
    $dbi->select(column => ['author', 'title']);
2288
    
2289
    # Constant value
2290
    $dbi->select(column => 'author');
2291

            
2292
Default is '*' unless C<column> is specified.
2293

            
2294
    # Default
2295
    $dbi->select(column => '*');
2296

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2297
You can use hash option in C<column>
2298

            
2299
=over 4
2300

            
2301
=item all EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2302

            
update pod
Yuki Kimoto authored on 2011-03-12
2303
Colum clause, contains all columns of joined table. This is true or false value
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2304

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2305
    $dbi->select(column => {all => 1});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2306

            
2307
If main table is C<book> and joined table is C<company>,
2308
This create the following column clause.
2309

            
2310
    book.author as author
2311
    book.company_id as company_id
2312
    company.id as company__id
2313
    company.name as company__name
2314

            
2315
Columns of main table is consist of only column name,
2316
Columns of joined table is consist of table and column name joined C<__>.
2317

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2318
Note that this option is failed unless modles is included and
2319
C<columns> attribute is set.
update pod
Yuki Kimoto authored on 2011-03-12
2320

            
2321
    # Generally do the following way before using all_column option
2322
    $dbi->include_model('MyModel')->setup_model;
2323

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2324
=item table EXPERIMENTAL
2325

            
2326
You can also specify table names by C<table> option
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2327

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
2328
    $dbi->select(column => {table => ['book', 'company']});
2329

            
2330
=item prepend EXPERIMENTAL
2331

            
2332
You can add before created statement
2333

            
2334
    $dbi->select(column => {prepend => 'SOME', all => 1});
2335

            
2336
=back
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
2337

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2338
=item C<where>
2339

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2340
Where clause. This is hash reference or L<DBIx::Custom::Where> object,
2341
or array refrence, which contains where clause and paramter.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2342
    
2343
    # Hash reference
update pod
Yuki Kimoto authored on 2011-03-12
2344
    $dbi->select(where => {author => 'Ken', 'title' => 'Perl'});
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2345
    
update pod
Yuki Kimoto authored on 2011-03-12
2346
    # DBIx::Custom::Where object
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2347
    my $where = $dbi->where(
2348
        clause => ['and', '{= author}', '{like title}'],
2349
        param  => {author => 'Ken', title => '%Perl%'}
2350
    );
update pod
Yuki Kimoto authored on 2011-03-12
2351
    $dbi->select(where => $where);
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2352

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2353
    # Array refrendce (where clause and parameter)
2354
    $dbi->select(where =>
2355
        [
2356
            ['and', '{= author}', '{like title}'],
2357
            {author => 'Ken', title => '%Perl%'}
2358
        ]
2359
    );
2360
    
update pod
Yuki Kimoto authored on 2011-03-13
2361
=item C<join> EXPERIMENTAL
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2362

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

            
2365
    $dbi->select(join =>
2366
        [
2367
            'left outer join company on book.company_id = company_id',
2368
            'left outer join location on company.location_id = location.id'
2369
        ]
2370
    );
2371

            
2372
If column cluase or where clause contain table name like "company.name",
2373
needed join clause is used automatically.
2374

            
2375
    $dbi->select(
2376
        table => 'book',
2377
        column => ['company.location_id as company__location_id'],
2378
        where => {'company.name' => 'Orange'},
2379
        join => [
2380
            'left outer join company on book.company_id = company.id',
2381
            'left outer join location on company.location_id = location.id'
2382
        ]
2383
    );
2384

            
2385
In above select, the following SQL is created.
2386

            
2387
    select company.location_id as company__location_id
2388
    from book
2389
      left outer join company on book.company_id = company.id
2390
    where company.name = Orange
2391

            
2392
=item C<append>
2393

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

            
2396
    $dbi->select(append => 'order by title');
2397

            
2398
=item C<filter>
2399

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

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

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

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

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

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

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

            
2438
    my $sql = $query->sql;
2439

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

            
2442
Specify database data type.
2443

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

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

            
2449
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2450

            
update pod
Yuki Kimoto authored on 2011-03-12
2451
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2452

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

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

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

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

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

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

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

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

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

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

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

            
2486
    # Constant value
2487
    $dbi->select(where => 5);
2488

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

            
2492
In first examle, the following SQL is created.
2493

            
2494
    select * from book where id = ?
2495

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2498
=back
2499

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2516
Table name.
2517

            
2518
    $dbi->update(table => 'book');
2519

            
2520
=item C<param>
2521

            
2522
Update data. This is hash reference.
2523

            
2524
    $dbi->update(param => {title => 'Perl'});
2525

            
2526
=item C<where>
2527

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

            
2549
=item C<append>
2550

            
2551
Append statement to last of SQL. This is string.
2552

            
2553
    $dbi->update(append => 'order by title');
2554

            
2555
=item C<filter>
2556

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

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

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

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

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

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

            
2593
You can check SQL.
2594

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2597
=back
2598

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

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

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

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

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

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

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

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

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

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

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

            
2633
This is used to create where clause.
2634

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

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

            
2640
    # Constant value
2641
    $dbi->update(where => 5);
2642

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

            
2646
In first examle, the following SQL is created.
2647

            
2648
    update book set title = ? where id = ?
2649

            
2650
Place holders are set to 'Perl' and 5.
2651

            
update pod
Yuki Kimoto authored on 2011-03-13
2652
=back
2653

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
2654
=head2 C<update_param>
update pod
Yuki Kimoto authored on 2011-03-13
2655

            
2656
    my $update_param = $dbi->update_param({title => 'a', age => 2});
2657

            
2658
Create update parameter tag.
2659

            
2660
    {update_param title age}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2661

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2664
    my $where = $dbi->where(
2665
        clause => ['and', '{= title}', '{= author}'],
2666
        param => {title => 'Perl', author => 'Ken'}
2667
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2668

            
2669
Create a new L<DBIx::Custom::Where> object.
2670

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2678
=head1 Tags
2679

            
2680
The following tags is available.
2681

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

            
2684
Table tag
2685

            
2686
    {table TABLE}    ->    TABLE
2687

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2690
=head2 C<?>
2691

            
2692
Placeholder tag.
2693

            
2694
    {? NAME}    ->   ?
2695

            
2696
=head2 C<=>
2697

            
2698
Equal tag.
2699

            
2700
    {= NAME}    ->   NAME = ?
2701

            
2702
=head2 C<E<lt>E<gt>>
2703

            
2704
Not equal tag.
2705

            
2706
    {<> NAME}   ->   NAME <> ?
2707

            
2708
=head2 C<E<lt>>
2709

            
2710
Lower than tag
2711

            
2712
    {< NAME}    ->   NAME < ?
2713

            
2714
=head2 C<E<gt>>
2715

            
2716
Greater than tag
2717

            
2718
    {> NAME}    ->   NAME > ?
2719

            
2720
=head2 C<E<gt>=>
2721

            
2722
Greater than or equal tag
2723

            
2724
    {>= NAME}   ->   NAME >= ?
2725

            
2726
=head2 C<E<lt>=>
2727

            
2728
Lower than or equal tag
2729

            
2730
    {<= NAME}   ->   NAME <= ?
2731

            
2732
=head2 C<like>
2733

            
2734
Like tag
2735

            
2736
    {like NAME}   ->   NAME like ?
2737

            
2738
=head2 C<in>
2739

            
2740
In tag.
2741

            
2742
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2743

            
2744
=head2 C<insert_param>
2745

            
2746
Insert parameter tag.
2747

            
2748
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2749

            
2750
=head2 C<update_param>
2751

            
2752
Updata parameter tag.
2753

            
2754
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2755

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

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

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

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

            
2765
C<< <kimoto.yuki at gmail.com> >>
2766

            
2767
L<http://github.com/yuki-kimoto/DBIx-Custom>
2768

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2769
=head1 AUTHOR
2770

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

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

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

            
2777
This program is free software; you can redistribute it and/or modify it
2778
under the same terms as Perl itself.
2779

            
2780
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2781

            
2782