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

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

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

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

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

            
added environment variable D...
Yuki Kimoto authored on 2011-04-02
22
use constant DEBUG => $ENV{DBIX_CUSTOM_DEBUG} || 0;
23

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

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

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

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

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

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
237
sub dbh {
238
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
239
    
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
240
    # From Connction manager
241
    if (my $connector = $self->connector) {
242
        croak "connector must have dbh() method"
243
          unless ref $connector && $connector->can('dbh');
244
          
245
        return $connector->dbh;
update pod
Yuki Kimoto authored on 2011-03-13
246
    }
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
247

            
248
    return $self->{dbh} ||= $self->_connect;
update pod
Yuki Kimoto authored on 2011-03-13
249
}
250

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
257
    # Check arguments
select, insert, update, upda...
yuki-kimoto authored on 2010-06-14
258
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
259
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
260
          unless $DELETE_ARGS{$name};
cleanup update and update_al...
yuki-kimoto authored on 2010-04-28
261
    }
262
    
263
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
264
    my $table = $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
265
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
266
    my $where            = delete $args{where} || {};
267
    my $append           = delete $args{append};
268
    my $allow_delete_all = delete $args{allow_delete_all};
cleanup
Yuki Kimoto authored on 2011-04-02
269
    my $query_return     = delete $args{query};
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
270

            
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
271
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
272
    $where = $self->_where_to_obj($where);
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
273
    
cleanup
Yuki Kimoto authored on 2011-04-02
274
    # Where clause
275
    my $where_clause = $where->to_string;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
276
    croak qq{"where" must be specified}
cleanup
Yuki Kimoto authored on 2011-04-02
277
      if $where_clause eq '' && !$allow_delete_all;
make delete() using where ob...
Yuki Kimoto authored on 2011-01-26
278

            
cleanup
Yuki Kimoto authored on 2011-04-02
279
    # Delete statement
cleanup
Yuki Kimoto authored on 2011-01-27
280
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
281
    my $q = $self->reserved_word_quote;
282
    push @sql, "delete from $q$table$q $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
283
    push @sql, $append if $append;
284
    my $sql = join(' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
285
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
286
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
287
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
288
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
289
    
packaging one directory
yuki-kimoto authored on 2009-11-16
290
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
291
    return $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
292
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
293
        param => $where->param,
cleanup
Yuki Kimoto authored on 2011-03-21
294
        table => $table,
295
        %args
296
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
297
}
298

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

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

            
303
sub delete_at {
304
    my ($self, %args) = @_;
305
    
cleanup
Yuki Kimoto authored on 2011-04-02
306
    # Arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
307
    my $primary_keys = delete $args{primary_key};
308
    $primary_keys = [$primary_keys] unless ref $primary_keys;
cleanup
Yuki Kimoto authored on 2011-04-02
309
    my $where = delete $args{where};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
310
    
cleanup
Yuki Kimoto authored on 2011-04-02
311
    # Check arguments
312
    foreach my $name (keys %args) {
313
        croak qq{Argument "$name" is wrong name}
314
          unless $DELETE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
315
    }
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
316
    
cleanup
Yuki Kimoto authored on 2011-04-02
317
    # Create where parameter
318
    my $where_param = $self->_create_where_param($where, $primary_keys);
319

            
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
320
    
cleanup
Yuki Kimoto authored on 2011-04-02
321
    return $self->delete(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
322
}
323

            
added helper method
yuki-kimoto authored on 2010-10-17
324
sub DESTROY { }
325

            
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
326
sub create_model {
327
    my $self = shift;
328
    
cleanup
Yuki Kimoto authored on 2011-04-02
329
    # Arguments
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
330
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
331
    $args->{dbi} = $self;
332
    my $model_class = delete $args->{model_class} || 'DBIx::Custom::Model';
333
    my $model_name  = delete $args->{name};
334
    my $model_table = delete $args->{table};
335
    $model_name ||= $model_table;
336
    
cleanup
Yuki Kimoto authored on 2011-04-02
337
    # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
338
    my $model = $model_class->new($args);
339
    $model->name($model_name) unless $model->name;
340
    $model->table($model_table) unless $model->table;
341
    
342
    # Apply filter
343
    croak "$model_class filter must be array reference"
344
      unless ref $model->filter eq 'ARRAY';
345
    $self->apply_filter($model->table, @{$model->filter});
346
    
cleanup
Yuki Kimoto authored on 2011-04-02
347
    # Associate table with model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
348
    croak "Table name is duplicated"
349
      if exists $self->{_model_from}->{$model->table};
350
    $self->{_model_from}->{$model->table} = $model->name;
351

            
352
    # Table alias
353
    $self->{_table_alias} ||= {};
354
    $self->{_table_alias} = {%{$self->{_table_alias}}, %{$model->table_alias}};
355
    
356
    # Set model
357
    $self->model($model->name, $model);
358
    
create_model() return model
Yuki Kimoto authored on 2011-03-29
359
    return $self->model($model->name);
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
360
}
361

            
362
sub each_column {
363
    my ($self, $cb) = @_;
364
    
365
    # Iterate all tables
366
    my $sth_tables = $self->dbh->table_info;
367
    while (my $table_info = $sth_tables->fetchrow_hashref) {
368
        
369
        # Table
370
        my $table = $table_info->{TABLE_NAME};
371
        
372
        # Iterate all columns
373
        my $sth_columns = $self->dbh->column_info(undef, undef, $table, '%');
374
        while (my $column_info = $sth_columns->fetchrow_hashref) {
375
            my $column = $column_info->{COLUMN_NAME};
376
            $self->$cb($table, $column, $column_info);
377
        }
378
    }
379
}
380

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

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

            
511
        return $result;
512
    }
cleanup
Yuki Kimoto authored on 2011-04-02
513
    
514
    # Not select statement
515
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
516
}
517

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

            
cleanup
yuki-kimoto authored on 2010-10-17
520
sub insert {
521
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
522
    
cleanup
yuki-kimoto authored on 2010-10-17
523
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
524
    my $table  = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
525
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
526
    my $param  = delete $args{param} || {};
527
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
528
    my $query_return  = delete $args{query};
529

            
530
    # Check arguments
531
    foreach my $name (keys %args) {
532
        croak qq{Argument "$name" is wrong name}
533
          unless $INSERT_ARGS{$name};
534
    }
535

            
536
    # Reserved word quote
537
    my $q = $self->reserved_word_quote;
cleanup
yuki-kimoto authored on 2010-10-17
538
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
539
    # Columns
540
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
541
    my $safety = $self->safety_character;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
542
    foreach my $column (keys %$param) {
543
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
544
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
545
          $column = "$q$column$q";
546
          $column =~ s/\./$q.$q/;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
547
        push @columns, $column;
548
    }
cleanup
yuki-kimoto authored on 2010-10-17
549
    
cleanup
Yuki Kimoto authored on 2011-04-02
550
    # Insert statement
cleanup
Yuki Kimoto authored on 2011-01-27
551
    my @sql;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
552
    push @sql, "insert into $q$table$q {insert_param ". join(' ', @columns) . '}';
cleanup
Yuki Kimoto authored on 2011-01-27
553
    push @sql, $append if $append;
554
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
555
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
556
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
557
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
558
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
559
    
packaging one directory
yuki-kimoto authored on 2009-11-16
560
    # Execute query
cleanup
Yuki Kimoto authored on 2011-04-02
561
    return $self->execute(
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
562
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
563
        param => $param,
cleanup
Yuki Kimoto authored on 2011-03-21
564
        table => $table,
565
        %args
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
566
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
567
}
568

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

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

            
574
    # Arguments
575
    my $primary_keys = delete $args{primary_key};
576
    $primary_keys = [$primary_keys] unless ref $primary_keys;
577
    my $where = delete $args{where};
578
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
579
    
cleanup
Yuki Kimoto authored on 2011-04-02
580
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
581
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
582
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
583
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
584
    }
585
    
cleanup
Yuki Kimoto authored on 2011-04-02
586
    # Create where parameter
587
    my $where_param = $self->_create_where_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-04-02
588
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
589
    
590
    return $self->insert(param => $param, %args);
591
}
592

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
593
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
594
    my ($self, $param) = @_;
595
    
cleanup
Yuki Kimoto authored on 2011-04-02
596
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
597
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
598
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
599
    my @columns;
600
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
601
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
602
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
603
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
604
        $column = "$q$column$q";
605
        $column =~ s/\./$q.$q/;
606
        push @columns, $column;
607
        push @placeholders, "{? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
608
    }
609
    
cleanup
Yuki Kimoto authored on 2011-04-02
610
    return '(' . join(', ', @columns) . ') ' . 'values ' .
611
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
612
}
613

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
614
sub include_model {
615
    my ($self, $name_space, $model_infos) = @_;
616
    
cleanup
Yuki Kimoto authored on 2011-04-02
617
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
618
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
619
    
620
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
621
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
622

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
623
        # Load name space module
624
        croak qq{"$name_space" is invalid class name}
625
          if $name_space =~ /[^\w:]/;
626
        eval "use $name_space";
627
        croak qq{Name space module "$name_space.pm" is needed. $@} if $@;
628
        
629
        # Search model modules
630
        my $path = $INC{"$name_space.pm"};
631
        $path =~ s/\.pm$//;
632
        opendir my $dh, $path
633
          or croak qq{Can't open directory "$path": $!};
634
        $model_infos = [];
635
        while (my $module = readdir $dh) {
636
            push @$model_infos, $module
637
              if $module =~ s/\.pm$//;
638
        }
639
        close $dh;
640
    }
641
    
cleanup
Yuki Kimoto authored on 2011-04-02
642
    # Include models
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
643
    foreach my $model_info (@$model_infos) {
644
        
cleanup
Yuki Kimoto authored on 2011-04-02
645
        # Load model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
646
        my $model_class;
647
        my $model_name;
648
        my $model_table;
649
        if (ref $model_info eq 'HASH') {
650
            $model_class = $model_info->{class};
651
            $model_name  = $model_info->{name};
652
            $model_table = $model_info->{table};
653
            
654
            $model_name  ||= $model_class;
655
            $model_table ||= $model_name;
656
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
657
        else { $model_class = $model_name = $model_table = $model_info }
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
658
        my $mclass = "${name_space}::$model_class";
659
        croak qq{"$mclass" is invalid class name}
660
          if $mclass =~ /[^\w:]/;
661
        unless ($mclass->can('isa')) {
662
            eval "use $mclass";
663
            croak $@ if $@;
664
        }
665
        
cleanup
Yuki Kimoto authored on 2011-04-02
666
        # Create model
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
667
        my $args = {};
668
        $args->{model_class} = $mclass if $mclass;
669
        $args->{name}        = $model_name if $model_name;
670
        $args->{table}       = $model_table if $model_table;
671
        $self->create_model($args);
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
672
    }
673
    
674
    return $self;
675
}
676

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
677
sub merge_param {
678
    my ($self, @params) = @_;
679
    
cleanup
Yuki Kimoto authored on 2011-04-02
680
    # Merge parameters
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
681
    my $param = {};
682
    foreach my $p (@params) {
683
        foreach my $column (keys %$p) {
684
            if (exists $param->{$column}) {
685
                $param->{$column} = [$param->{$column}]
686
                  unless ref $param->{$column} eq 'ARRAY';
687
                push @{$param->{$column}}, $p->{$column};
688
            }
689
            else {
690
                $param->{$column} = $p->{$column};
691
            }
692
        }
693
    }
694
    
695
    return $param;
696
}
697

            
cleanup
Yuki Kimoto authored on 2011-03-21
698
sub method {
699
    my $self = shift;
700
    
cleanup
Yuki Kimoto authored on 2011-04-02
701
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
702
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
703
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
704
    
705
    return $self;
706
}
707

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
708
sub model {
709
    my ($self, $name, $model) = @_;
710
    
cleanup
Yuki Kimoto authored on 2011-04-02
711
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
712
    if ($model) {
713
        $self->models->{$name} = $model;
714
        return $self;
715
    }
716
    
717
    # Check model existance
718
    croak qq{Model "$name" is not included}
719
      unless $self->models->{$name};
720
    
cleanup
Yuki Kimoto authored on 2011-04-02
721
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
722
    return $self->models->{$name};
723
}
724

            
cleanup
Yuki Kimoto authored on 2011-03-21
725
sub mycolumn {
726
    my ($self, $table, $columns) = @_;
727
    
cleanup
Yuki Kimoto authored on 2011-04-02
728
    # Create column clause
729
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
730
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
731
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
732
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
733
    
734
    return join (', ', @column);
735
}
736

            
added dbi_options attribute
kimoto authored on 2010-12-20
737
sub new {
738
    my $self = shift->SUPER::new(@_);
739
    
cleanup
Yuki Kimoto authored on 2011-04-02
740
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
741
    my @attrs = keys %$self;
742
    foreach my $attr (@attrs) {
cleanup
Yuki Kimoto authored on 2011-04-02
743
        croak qq{"$attr" is wrong name}
added dbi_options attribute
kimoto authored on 2010-12-20
744
          unless $self->can($attr);
745
    }
cleanup
Yuki Kimoto authored on 2011-04-02
746
    
747
    # Register tag
cleanup
Yuki Kimoto authored on 2011-01-25
748
    $self->register_tag(
749
        '?'     => \&DBIx::Custom::Tag::placeholder,
750
        '='     => \&DBIx::Custom::Tag::equal,
751
        '<>'    => \&DBIx::Custom::Tag::not_equal,
752
        '>'     => \&DBIx::Custom::Tag::greater_than,
753
        '<'     => \&DBIx::Custom::Tag::lower_than,
754
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
755
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
756
        'like'  => \&DBIx::Custom::Tag::like,
757
        'in'    => \&DBIx::Custom::Tag::in,
758
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
759
        'update_param' => \&DBIx::Custom::Tag::update_param
760
    );
added dbi_options attribute
kimoto authored on 2010-12-20
761
    
762
    return $self;
763
}
764

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

            
cleanup
yuki-kimoto authored on 2010-10-17
767
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
768
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
769
    
770
    # Register filter
771
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
772
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
773
    
cleanup
Yuki Kimoto authored on 2011-04-02
774
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
775
}
packaging one directory
yuki-kimoto authored on 2009-11-16
776

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

            
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
779
sub replace {
780
    my ($self, $join, $search, $replace) = @_;
781
    
cleanup
Yuki Kimoto authored on 2011-04-02
782
    # Replace
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
783
    my @replace_join;
784
    my $is_replaced;
785
    foreach my $j (@$join) {
786
        if ($search eq $j) {
787
            push @replace_join, $replace;
788
            $is_replaced = 1;
789
        }
790
        else {
791
            push @replace_join, $j;
792
        }
793
    }
794
    croak qq{Can't replace "$search" with "$replace"} unless $is_replaced;
795
    
change retern value to array...
Yuki Kimoto authored on 2011-04-04
796
    return \@replace_join;
added EXPERIMENTAL replace()...
Yuki Kimoto authored on 2011-04-01
797
}
798

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

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

            
refactoring select
yuki-kimoto authored on 2010-04-28
805
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
806
    my $table = delete $args{table};
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
807
    my $tables = ref $table eq 'ARRAY' ? $table
808
               : defined $table ? [$table]
809
               : [];
cleanup
Yuki Kimoto authored on 2011-03-21
810
    my $columns   = delete $args{column};
811
    my $where     = delete $args{where} || {};
812
    my $append    = delete $args{append};
813
    my $join      = delete $args{join} || [];
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
814
    croak qq{"join" must be array reference}
815
      unless ref $join eq 'ARRAY';
cleanup
Yuki Kimoto authored on 2011-03-21
816
    my $relation = delete $args{relation};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
817
    my $param = delete $args{param} || {};
cleanup
Yuki Kimoto authored on 2011-04-02
818
    my $query_return = $args{query};
819

            
820
    # Check arguments
821
    foreach my $name (keys %args) {
822
        croak qq{Argument "$name" is wrong name}
823
          unless $SELECT_ARGS{$name};
824
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
825
    
cleanup
Yuki Kimoto authored on 2011-03-09
826
    # Add relation tables(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-03-21
827
    $self->_add_relation_table($tables, $relation);
packaging one directory
yuki-kimoto authored on 2009-11-16
828
    
cleanup
Yuki Kimoto authored on 2011-04-02
829
    # Select statement
cleanup
Yuki Kimoto authored on 2011-01-27
830
    my @sql;
831
    push @sql, 'select';
packaging one directory
yuki-kimoto authored on 2009-11-16
832
    
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
833
    # Column clause
cleanup
Yuki Kimoto authored on 2011-03-30
834
    if ($columns) {
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
835
        $columns = [$columns] if ! ref $columns;
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
836
        foreach my $column (@$columns) {
cleanup
Yuki Kimoto authored on 2011-04-02
837
            unshift @$tables, @{$self->_search_tables($column)};
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
838
            push @sql, ($column, ',');
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
839
        }
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
840
        pop @sql if $sql[-1] eq ',';
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
841
    }
842
    else { push @sql, '*' }
843
    
844
    # Table
cleanup
Yuki Kimoto authored on 2011-03-30
845
    push @sql, 'from';
cleanup
Yuki Kimoto authored on 2011-04-02
846
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-30
847
    if ($relation) {
848
        my $found = {};
849
        foreach my $table (@$tables) {
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
850
            push @sql, ("$q$table$q", ',') unless $found->{$table};
cleanup
Yuki Kimoto authored on 2011-03-30
851
            $found->{$table} = 1;
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-14
852
        }
packaging one directory
yuki-kimoto authored on 2009-11-16
853
    }
cleanup
Yuki Kimoto authored on 2011-03-30
854
    else {
855
        my $main_table = $tables->[-1] || '';
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
856
        push @sql, "$q$main_table$q";
cleanup
Yuki Kimoto authored on 2011-03-30
857
    }
858
    pop @sql if ($sql[-1] || '') eq ',';
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
859
    croak "Not found table name" unless $tables->[-1];
cleanup
Yuki Kimoto authored on 2011-04-01
860

            
cleanup
Yuki Kimoto authored on 2011-04-02
861
    # Add tables in parameter
862
    unshift @$tables, @{$self->_search_tables(join(' ', keys %$param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
863
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
864
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
865
    $where = $self->_where_to_obj($where);
866
    $param = keys %$param ? $self->merge_param($param, $where->param)
867
                          : $where->param;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
868
    
869
    # String where
cleanup
Yuki Kimoto authored on 2011-04-02
870
    my $where_clause = $where->to_string;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
871
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
872
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
873
    unshift @$tables, @{$self->_search_tables($where_clause)};
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
874
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
875
    # Push join
876
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
877
    
cleanup
Yuki Kimoto authored on 2011-03-09
878
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
879
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
880
    
cleanup
Yuki Kimoto authored on 2011-03-08
881
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
882
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
883
    
cleanup
Yuki Kimoto authored on 2011-04-02
884
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
885
    push @sql, $append if $append;
886
    
887
    # SQL
888
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
889
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
890
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
891
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
892
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
893
    
packaging one directory
yuki-kimoto authored on 2009-11-16
894
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
895
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
896
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
897
        param => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
898
        table => $tables,
899
        %args
900
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
901
    
902
    return $result;
903
}
904

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

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

            
910
    # Arguments
911
    my $primary_keys = delete $args{primary_key};
912
    $primary_keys = [$primary_keys] unless ref $primary_keys;
913
    my $where = delete $args{where};
914
    my $param = delete $args{param};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
915
    
cleanup
Yuki Kimoto authored on 2011-04-02
916
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
917
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
918
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
919
          unless $SELECT_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
920
    }
921
    
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
922
    # Table
923
    croak qq{"table" option must be specified} unless $args{table};
924
    my $table = ref $args{table} ? $args{table}->[-1] : $args{table};
925
    
cleanup
Yuki Kimoto authored on 2011-04-02
926
    # Create where parameter
927
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
928
    
cleanup
Yuki Kimoto authored on 2011-04-02
929
    return $self->select(where => $where_param, %args);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
930
}
931

            
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
932
sub setup_model {
933
    my $self = shift;
934
    
cleanup
Yuki Kimoto authored on 2011-04-02
935
    # Setup model
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
936
    $self->each_column(
937
        sub {
938
            my ($self, $table, $column, $column_info) = @_;
939
            if (my $model = $self->models->{$table}) {
940
                push @{$model->columns}, $column;
941
            }
942
        }
943
    );
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
944
    return $self;
add experimental setup_model...
Yuki Kimoto authored on 2011-02-21
945
}
946

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
953
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
954
    my $table = delete $args{table} || '';
added table not specified ex...
Yuki Kimoto authored on 2011-01-21
955
    croak qq{"table" option must be specified} unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
956
    my $param            = delete $args{param} || {};
957
    my $where            = delete $args{where} || {};
958
    my $append           = delete $args{append} || '';
959
    my $allow_update_all = delete $args{allow_update_all};
version 0.0901
yuki-kimoto authored on 2009-12-17
960
    
cleanup
Yuki Kimoto authored on 2011-04-02
961
    # Check argument names
962
    foreach my $name (keys %args) {
963
        croak qq{Argument "$name" is wrong name}
964
          unless $UPDATE_ARGS{$name};
965
    }
966
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
967
    # Columns
968
    my @columns;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
969
    my $safety = $self->safety_character;
cleanup
Yuki Kimoto authored on 2011-04-02
970
    my $q = $self->reserved_word_quote;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
971
    foreach my $column (keys %$param) {
972
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
973
          unless $column =~ /^[$safety\.]+$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
974
          $column = "$q$column$q";
975
          $column =~ s/\./$q.$q/;
976
        push @columns, "$column";
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
977
    }
978
        
cleanup
yuki-kimoto authored on 2010-10-17
979
    # Update clause
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
980
    my $update_clause = '{update_param ' . join(' ', @columns) . '}';
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
981

            
982
    # Where
cleanup
Yuki Kimoto authored on 2011-04-02
983
    $where = $self->_where_to_obj($where);
984
    my $where_clause = $where->to_string;
improved delete() and update...
Yuki Kimoto authored on 2011-01-26
985
    croak qq{"where" must be specified}
cleanup
Yuki Kimoto authored on 2011-04-02
986
      if "$where_clause" eq '' && !$allow_update_all;
removed reconnect method
yuki-kimoto authored on 2010-05-28
987
    
cleanup
Yuki Kimoto authored on 2011-04-02
988
    # Update statement
cleanup
Yuki Kimoto authored on 2011-01-27
989
    my @sql;
cleanup
Yuki Kimoto authored on 2011-04-02
990
    push @sql, "update $q$table$q $update_clause $where_clause";
cleanup
Yuki Kimoto authored on 2011-01-27
991
    push @sql, $append if $append;
removed reconnect method
yuki-kimoto authored on 2010-05-28
992
    
cleanup
Yuki Kimoto authored on 2011-04-02
993
    # Merge parameters
994
    $param = $self->merge_param($param, $where->param);
cleanup
yuki-kimoto authored on 2010-10-17
995
    
cleanup
Yuki Kimoto authored on 2011-01-27
996
    # SQL
997
    my $sql = join(' ', @sql);
998
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
999
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
1000
    my $query = $self->create_query($sql);
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
1001
    return $query if $args{query};
1002
    
cleanup
yuki-kimoto authored on 2010-10-17
1003
    # Execute query
cleanup
Yuki Kimoto authored on 2011-03-21
1004
    my $ret_val = $self->execute(
1005
        $query,
1006
        param  => $param, 
1007
        table => $table,
1008
        %args
1009
    );
cleanup
yuki-kimoto authored on 2010-10-17
1010
    
1011
    return $ret_val;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1012
}
1013

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

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

            
1018
sub update_at {
1019
    my ($self, %args) = @_;
1020
    
cleanup
Yuki Kimoto authored on 2011-04-02
1021
    # Arguments
1022
    my $primary_keys = delete $args{primary_key};
1023
    $primary_keys = [$primary_keys] unless ref $primary_keys;
1024
    my $where = delete $args{where};
1025
    
1026

            
1027
    # Check arguments
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1028
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-02
1029
        croak qq{Argument "$name" is wrong name}
cleanup
Yuki Kimoto authored on 2011-03-21
1030
          unless $UPDATE_AT_ARGS{$name};
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1031
    }
1032
    
cleanup
Yuki Kimoto authored on 2011-04-02
1033
    # Create where parameter
1034
    my $where_param = $self->_create_where_param($where, $primary_keys);
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1035
    
cleanup
Yuki Kimoto authored on 2011-04-02
1036
    return $self->update(where => $where_param, %args);
1037
}
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1038

            
cleanup
Yuki Kimoto authored on 2011-04-02
1039
sub _create_where_param {
1040
    my ($self, $where, $primary_keys) = @_;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1041
    
cleanup
Yuki Kimoto authored on 2011-04-02
1042
    # Create where parameter
1043
    my $where_param = {};
1044
    if ($where) {
1045
        $where = [$where] unless ref $where;
1046
        croak qq{"where" must be constant value or array reference}
1047
          unless !ref $where || ref $where eq 'ARRAY';
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1048
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
1049
           $where_param->{$primary_keys->[$i]} = $where->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1050
        }
1051
    }
1052
    
cleanup
Yuki Kimoto authored on 2011-04-02
1053
    return $where_param;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1054
}
1055

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1056
sub update_param_tag {
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1057
    my ($self, $param, $opt) = @_;
1058
    
cleanup
Yuki Kimoto authored on 2011-04-02
1059
    # Create update parameter tag
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1060
    my @params;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1061
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
1062
    my $q = $self->reserved_word_quote;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1063
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
1064
        croak qq{"$column" is not safety column name}
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1065
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
1066
        my $column = "$q$column$q";
1067
        $column =~ s/\./$q.$q/;
1068
        push @params, "$column = {? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1069
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1070
    my $tag;
1071
    $tag .= 'set ' unless $opt->{no_set};
1072
    $tag .= join(', ', @params);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1073
    
cleanup
Yuki Kimoto authored on 2011-04-02
1074
    return $tag;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
1075
}
1076

            
cleanup
Yuki Kimoto authored on 2011-01-25
1077
sub where {
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1078
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
1079
    
1080
    # Create where
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1081
    return DBIx::Custom::Where->new(
1082
        query_builder => $self->query_builder,
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1083
        safety_character => $self->safety_character,
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1084
        reserved_word_quote => $self->reserved_word_quote,
cleanup
Yuki Kimoto authored on 2011-03-09
1085
        @_
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
1086
    );
cleanup
Yuki Kimoto authored on 2011-01-25
1087
}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
1088

            
cleanup
Yuki Kimoto authored on 2011-04-02
1089
sub _create_bind_values {
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1090
    my ($self, $params, $columns, $filter, $type) = @_;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1091
    
cleanup
Yuki Kimoto authored on 2011-04-02
1092
    # Create bind values
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1093
    my $bind = [];
removed reconnect method
yuki-kimoto authored on 2010-05-28
1094
    my $count = {};
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1095
    my $not_exists = {};
cleanup
Yuki Kimoto authored on 2011-01-12
1096
    foreach my $column (@$columns) {
removed reconnect method
yuki-kimoto authored on 2010-05-28
1097
        
1098
        # Value
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
1099
        my $value;
1100
        if(ref $params->{$column} eq 'ARRAY') {
1101
            my $i = $count->{$column} || 0;
1102
            $i += $not_exists->{$column} || 0;
1103
            my $found;
1104
            for (my $k = $i; $i < @{$params->{$column}}; $k++) {
1105
                if (ref $params->{$column}->[$k] eq 'DBIx::Custom::NotExists') {
1106
                    $not_exists->{$column}++;
1107
                }
1108
                else  {
1109
                    $value = $params->{$column}->[$k];
1110
                    $found = 1;
1111
                    last
1112
                }
1113
            }
1114
            next unless $found;
1115
        }
1116
        else { $value = $params->{$column} }
removed reconnect method
yuki-kimoto authored on 2010-05-28
1117
        
cleanup
Yuki Kimoto authored on 2011-01-12
1118
        # Filter
1119
        my $f = $filter->{$column} || $self->{default_out_filter} || '';
cleanup
kimoto.yuki@gmail.com authored on 2010-12-21
1120
        
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1121
        # Type
1122
        push @$bind, {
1123
            value => $f ? $f->($value) : $value,
1124
            type => $type->{$column}
1125
        };
removed reconnect method
yuki-kimoto authored on 2010-05-28
1126
        
1127
        # Count up 
1128
        $count->{$column}++;
1129
    }
1130
    
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
1131
    return $bind;
removed reconnect method
yuki-kimoto authored on 2010-05-28
1132
}
1133

            
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1134
sub _connect {
1135
    my $self = shift;
1136
    
1137
    # Attributes
1138
    my $data_source = $self->data_source;
1139
    croak qq{"data_source" must be specified to connect()"}
1140
      unless $data_source;
1141
    my $user        = $self->user;
1142
    my $password    = $self->password;
1143
    my $dbi_option = {%{$self->dbi_options}, %{$self->dbi_option}};
1144
    
1145
    # Connect
1146
    my $dbh = eval {DBI->connect(
1147
        $data_source,
1148
        $user,
1149
        $password,
1150
        {
1151
            %{$self->default_dbi_option},
1152
            %$dbi_option
1153
        }
1154
    )};
1155
    
1156
    # Connect error
1157
    croak $@ if $@;
1158
    
1159
    return $dbh;
1160
}
1161

            
cleanup
yuki-kimoto authored on 2010-10-17
1162
sub _croak {
1163
    my ($self, $error, $append) = @_;
cleanup
Yuki Kimoto authored on 2011-04-02
1164
    
1165
    # Append
cleanup
yuki-kimoto authored on 2010-10-17
1166
    $append ||= "";
1167
    
1168
    # Verbose
1169
    if ($Carp::Verbose) { croak $error }
1170
    
1171
    # Not verbose
1172
    else {
1173
        
1174
        # Remove line and module infromation
1175
        my $at_pos = rindex($error, ' at ');
1176
        $error = substr($error, 0, $at_pos);
1177
        $error =~ s/\s+$//;
1178
        croak "$error$append";
1179
    }
1180
}
1181

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1182
sub _need_tables {
1183
    my ($self, $tree, $need_tables, $tables) = @_;
1184
    
cleanup
Yuki Kimoto authored on 2011-04-02
1185
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1186
    foreach my $table (@$tables) {
1187
        if ($tree->{$table}) {
1188
            $need_tables->{$table} = 1;
1189
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1190
        }
1191
    }
1192
}
1193

            
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1194
sub _push_join {
1195
    my ($self, $sql, $join, $join_tables) = @_;
1196
    
cleanup
Yuki Kimoto authored on 2011-04-02
1197
    # No join
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1198
    return unless @$join;
1199
    
cleanup
Yuki Kimoto authored on 2011-04-02
1200
    # Push join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1201
    my $tree = {};
cleanup
Yuki Kimoto authored on 2011-04-02
1202
    my $q = $self->reserved_word_quote;
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1203
    for (my $i = 0; $i < @$join; $i++) {
1204
        
cleanup
Yuki Kimoto authored on 2011-04-02
1205
        # Search table in join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1206
        my $join_clause = $join->[$i];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1207
        my $q_re = quotemeta($q);
cleanup
Yuki Kimoto authored on 2011-04-01
1208
        my $join_re = $q ? qr/\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?\s$q_re?([^\.\s$q_re]+?)$q_re?\..+?$/
1209
                         : qr/\s([^\.\s]+?)\..+?\s([^\.\s]+?)\..+?$/;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1210
        if ($join_clause =~ $join_re) {
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1211
            my $table1 = $1;
1212
            my $table2 = $2;
1213
            croak qq{right side table of "$join_clause" must be uniq}
1214
              if exists $tree->{$table2};
1215
            $tree->{$table2}
1216
              = {position => $i, parent => $table1, join => $join_clause};
1217
        }
1218
        else {
1219
            croak qq{join "$join_clause" must be two table name};
1220
        }
1221
    }
1222
    
cleanup
Yuki Kimoto authored on 2011-04-02
1223
    # Search need tables
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1224
    my $need_tables = {};
1225
    $self->_need_tables($tree, $need_tables, $join_tables);
1226
    my @need_tables = sort { $tree->{$a}{position} <=> $tree->{$b}{position} } keys %$need_tables;
cleanup
Yuki Kimoto authored on 2011-04-02
1227
    
1228
    # Add join clause
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
1229
    foreach my $need_table (@need_tables) {
1230
        push @$sql, $tree->{$need_table}{join};
1231
    }
1232
}
cleanup
Yuki Kimoto authored on 2011-03-08
1233

            
cleanup
Yuki Kimoto authored on 2011-04-02
1234
sub _remove_duplicate_table {
1235
    my ($self, $tables, $main_table) = @_;
1236
    
1237
    # Remove duplicate table
1238
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1239
    delete $tables{$main_table} if $main_table;
1240
    
1241
    return [keys %tables, $main_table ? $main_table : ()];
1242
}
1243

            
cleanup
Yuki Kimoto authored on 2011-04-02
1244
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1245
    my ($self, $source) = @_;
1246
    
cleanup
Yuki Kimoto authored on 2011-04-02
1247
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1248
    my $tables = [];
1249
    my $safety_character = $self->safety_character;
1250
    my $q = $self->reserved_word_quote;
1251
    my $q_re = quotemeta($q);
1252
    my $table_re = $q ? qr/\b$q_re?([$safety_character]+)$q_re?\./
1253
                      : qr/\b([$safety_character]+)\./;
1254
    while ($source =~ /$table_re/g) {
1255
        push @$tables, $1;
1256
    }
1257
    
1258
    return $tables;
1259
}
1260

            
cleanup
Yuki Kimoto authored on 2011-04-02
1261
sub _where_to_obj {
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1262
    my ($self, $where) = @_;
1263
    
cleanup
Yuki Kimoto authored on 2011-04-02
1264
    my $obj;
1265
    
1266
    # Hash
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1267
    if (ref $where eq 'HASH') {
1268
        my $clause = ['and'];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1269
        my $q = $self->reserved_word_quote;
1270
        foreach my $column (keys %$where) {
1271
            $column = "$q$column$q";
1272
            $column =~ s/\./$q.$q/;
1273
            push @$clause, "{= $column}" for keys %$where;
1274
        }
cleanup
Yuki Kimoto authored on 2011-04-02
1275
        $obj = $self->where(clause => $clause, param => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1276
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1277
    
1278
    # DBIx::Custom::Where object
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1279
    elsif (ref $where eq 'DBIx::Custom::Where') {
cleanup
Yuki Kimoto authored on 2011-04-02
1280
        $obj = $where;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1281
    }
cleanup
Yuki Kimoto authored on 2011-04-02
1282
    
1283
    # Array(DEPRECATED!)
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1284
    elsif (ref $where eq 'ARRAY') {
removed EXPERIMETNAL select(...
Yuki Kimoto authored on 2011-04-01
1285
        warn "\$dbi->select(where => [CLAUSE, PARAMETER]) is DEPRECATED." .
1286
             "use \$dbi->select(where => \$dbi->where(clause => " .
1287
             "CLAUSE, param => PARAMETER));";
cleanup
Yuki Kimoto authored on 2011-04-02
1288
        $obj = $self->where(
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1289
            clause => $where->[0],
1290
            param  => $where->[1]
1291
        );
1292
    }
1293
    
cleanup
Yuki Kimoto authored on 2011-04-02
1294
    # Check where argument
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1295
    croak qq{"where" must be hash reference or DBIx::Custom::Where object} .
1296
          qq{or array reference, which contains where clause and paramter}
cleanup
Yuki Kimoto authored on 2011-04-02
1297
      unless ref $obj eq 'DBIx::Custom::Where';
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1298
    
cleanup
Yuki Kimoto authored on 2011-04-02
1299
    return $obj;
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1300
}
1301

            
cleanup
Yuki Kimoto authored on 2011-01-25
1302
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1303
__PACKAGE__->attr(
1304
    dbi_options => sub { {} },
1305
    filter_check  => 1
1306
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1307

            
cleanup
Yuki Kimoto authored on 2011-01-25
1308
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1309
sub default_bind_filter {
1310
    my $self = shift;
1311
    
1312
    if (@_) {
1313
        my $fname = $_[0];
1314
        
1315
        if (@_ && !$fname) {
1316
            $self->{default_out_filter} = undef;
1317
        }
1318
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1319
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1320
              unless exists $self->filters->{$fname};
1321
        
1322
            $self->{default_out_filter} = $self->filters->{$fname};
1323
        }
1324
        return $self;
1325
    }
1326
    
1327
    return $self->{default_out_filter};
1328
}
1329

            
cleanup
Yuki Kimoto authored on 2011-01-25
1330
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1331
sub default_fetch_filter {
1332
    my $self = shift;
1333
    
1334
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1335
        my $fname = $_[0];
1336

            
cleanup
Yuki Kimoto authored on 2011-01-12
1337
        if (@_ && !$fname) {
1338
            $self->{default_in_filter} = undef;
1339
        }
1340
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1341
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1342
              unless exists $self->filters->{$fname};
1343
        
1344
            $self->{default_in_filter} = $self->filters->{$fname};
1345
        }
1346
        
1347
        return $self;
1348
    }
1349
    
many changed
Yuki Kimoto authored on 2011-01-23
1350
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1351
}
1352

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1353
# DEPRECATED!
1354
sub insert_param {
1355
    warn "insert_param is renamed to insert_param_tag."
1356
       . " insert_param is DEPRECATED!";
1357
    return shift->insert_param_tag(@_);
1358
}
1359

            
cleanup
Yuki Kimoto authored on 2011-01-25
1360
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1361
sub register_tag_processor {
1362
    return shift->query_builder->register_tag_processor(@_);
1363
}
1364

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1365
# DEPRECATED!
1366
sub update_param {
1367
    warn "update_param is renamed to update_param_tag."
1368
       . " update_param is DEPRECATED!";
1369
    return shift->update_param_tag(@_);
1370
}
cleanup
Yuki Kimoto authored on 2011-03-08
1371
# DEPRECATED!
1372
sub _push_relation {
1373
    my ($self, $sql, $tables, $relation, $need_where) = @_;
1374
    
1375
    if (keys %{$relation || {}}) {
1376
        push @$sql, $need_where ? 'where' : 'and';
1377
        foreach my $rcolumn (keys %$relation) {
1378
            my $table1 = (split (/\./, $rcolumn))[0];
1379
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1380
            push @$tables, ($table1, $table2);
1381
            push @$sql, ("$rcolumn = " . $relation->{$rcolumn},  'and');
1382
        }
1383
    }
1384
    pop @$sql if $sql->[-1] eq 'and';    
1385
}
1386

            
1387
# DEPRECATED!
1388
sub _add_relation_table {
cleanup
Yuki Kimoto authored on 2011-03-09
1389
    my ($self, $tables, $relation) = @_;
cleanup
Yuki Kimoto authored on 2011-03-08
1390
    
1391
    if (keys %{$relation || {}}) {
1392
        foreach my $rcolumn (keys %$relation) {
1393
            my $table1 = (split (/\./, $rcolumn))[0];
1394
            my $table2 = (split (/\./, $relation->{$rcolumn}))[0];
1395
            my $table1_exists;
1396
            my $table2_exists;
1397
            foreach my $table (@$tables) {
1398
                $table1_exists = 1 if $table eq $table1;
1399
                $table2_exists = 1 if $table eq $table2;
1400
            }
1401
            unshift @$tables, $table1 unless $table1_exists;
1402
            unshift @$tables, $table2 unless $table2_exists;
1403
        }
1404
    }
1405
}
1406

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1409
=head1 NAME
1410

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

            
1413
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1414

            
renamed build_query to creat...
yuki-kimoto authored on 2010-08-06
1415
    use DBIx::Custom;
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1416
    
1417
    # Connect
1418
    my $dbi = DBIx::Custom->connect(
1419
        data_source => "dbi:mysql:database=dbname",
1420
        user => 'ken',
1421
        password => '!LFKD%$&',
1422
        dbi_option => {mysql_enable_utf8 => 1}
1423
    );
cleanup
yuki-kimoto authored on 2010-08-05
1424

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1425
    # Insert 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1426
    $dbi->insert(
1427
        table  => 'book',
1428
        param  => {title => 'Perl', author => 'Ken'}
1429
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1430
    
1431
    # Update 
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1432
    $dbi->update(
1433
        table  => 'book', 
1434
        param  => {title => 'Perl', author => 'Ken'}, 
1435
        where  => {id => 5},
1436
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
1437
    
1438
    # Delete
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1439
    $dbi->delete(
1440
        table  => 'book',
1441
        where  => {author => 'Ken'},
1442
    );
cleanup
yuki-kimoto authored on 2010-08-05
1443

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1450
    # Select, more complex
1451
    my $result = $dbi->select(
1452
        table  => 'book',
1453
        column => [
1454
            'book.author as book__author',
1455
            'company.name as company__name'
1456
        ],
1457
        where  => {'book.author' => 'Ken'},
1458
        join => ['left outer join company on book.company_id = company.id'],
1459
        append => 'order by id limit 5'
removed reconnect method
yuki-kimoto authored on 2010-05-28
1460
    );
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1461
    
removed register_format()
yuki-kimoto authored on 2010-05-26
1462
    # Fetch
1463
    while (my $row = $result->fetch) {
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1464
        
removed register_format()
yuki-kimoto authored on 2010-05-26
1465
    }
1466
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1467
    # Fetch as hash
removed register_format()
yuki-kimoto authored on 2010-05-26
1468
    while (my $row = $result->fetch_hash) {
1469
        
1470
    }
1471
    
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1472
    # Execute SQL with parameter.
1473
    $dbi->execute(
1474
        "select id from book where {= author} and {like title}",
1475
        param  => {author => 'ken', title => '%Perl%'}
1476
    );
1477
    
renamed update tag to update...
yuki-kimoto authored on 2010-08-09
1478
=head1 DESCRIPTIONS
removed reconnect method
yuki-kimoto authored on 2010-05-28
1479

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

            
1482
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1483

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1488
There are many basic methods to execute various queries.
1489
C<insert()>, C<update()>, C<update_all()>,C<delete()>,
1490
C<delete_all()>, C<select()>,
1491
C<insert_at()>, C<update_at()>, 
1492
C<delete_at()>, C<select_at()>, C<execute()>
removed reconnect method
yuki-kimoto authored on 2010-05-28
1493

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1494
=item *
1495

            
1496
Filter when data is send or receive.
1497

            
1498
=item *
1499

            
1500
Data filtering system
1501

            
1502
=item *
1503

            
1504
Model support.
1505

            
1506
=item *
1507

            
1508
Generate where clause dinamically.
1509

            
1510
=item *
1511

            
1512
Generate join clause dinamically.
1513

            
1514
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1515

            
1516
=head1 GUIDE
1517

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

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

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

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

            
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1526
=head2 C<connector> EXPERIMENTAL
1527

            
1528
    my $connector = $dbi->connector;
1529
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1530

            
1531
Connection manager object. if connector is set, you can get C<dbh()>
1532
from connection manager. conection manager object must have dbh() mehtod.
1533

            
1534
This is L<DBIx::Connector> example. Please pass
1535
C<default_dbi_option> to L<DBIx::Connector>.
1536

            
1537
    my $connector = DBIx::Connector->new(
1538
        "dbi:mysql:database=$DATABASE",
1539
        $USER,
1540
        $PASSWORD,
1541
        DBIx::Custom->new->default_dbi_option
1542
    );
1543
    
1544
    my $dbi = DBIx::Custom->new(connector => $connector);
1545

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

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

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

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

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

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

            
1561
=head2 C<default_dbi_option>
1562

            
1563
    my $default_dbi_option = $dbi->default_dbi_option;
1564
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1565

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

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

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

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

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

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

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

            
1587
    my $models = $dbi->models;
1588
    $dbi       = $dbi->models(\%models);
1589

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1592
=head2 C<password>
1593

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

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

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

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

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

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

            
1608
     my reserved_word_quote = $dbi->reserved_word_quote;
1609
     $dbi                   = $dbi->reserved_word_quote('"');
1610

            
cleanup
Yuki Kimoto authored on 2011-04-02
1611
Reserved word quote, default to empty string.
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
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

            
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1738
Get L<DBI> database handle. if C<connector> is set, you can get
1739
database handle from C<connector>.
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1740

            
1741
=head2 C<each_column>
1742

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

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

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

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

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

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

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

            
1776
See also L<Tags/Tags>.
1777

            
1778
The following opitons are currently available.
1779

            
1780
=over 4
1781

            
1782
=item C<filter>
1783

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

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

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

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

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

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

            
1822
Delete statement.
1823

            
1824
The following opitons are currently available.
1825

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

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

            
1830
Table name.
1831

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

            
1834
=item C<where>
1835

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

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

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

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

            
1863
=item C<filter>
1864

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

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

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

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

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

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

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

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

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

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

            
1910
You can check SQL.
1911

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1949
This is used to create where clause.
1950

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

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

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

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

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

            
1964
    delete from book where id = ?;
1965

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

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

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

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

            
1977
Insert statement.
1978

            
1979
The following opitons are currently available.
1980

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

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

            
1985
Table name.
1986

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

            
1989
=item C<param>
1990

            
1991
Insert data. This is hash reference.
1992

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

            
1995
=item C<append>
1996

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

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

            
2001
=item C<filter>
2002

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2097
Create insert parameter tag.
2098

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2153
Merge paramters.
2154

            
2155
$param:
2156

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2283
Replace join clauses if match the expression.
2284

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

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

            
2295
The following opitons are currently available.
2296

            
2297
=over 4
2298

            
2299
=item C<table>
2300

            
2301
Table name.
2302

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

            
2305
=item C<column>
2306

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

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

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

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

            
2320
=item C<where>
2321

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2396
=item C<filter>
2397

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

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

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

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

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

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

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

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

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

            
2440
Specify database data type.
2441

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2492
    select * from book where id = ?
2493

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

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

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

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

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

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

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

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

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

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

            
2518
=item C<param>
2519

            
2520
Update data. This is hash reference.
2521

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

            
2524
=item C<where>
2525

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

            
2547
=item C<append>
2548

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

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

            
2553
=item C<filter>
2554

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

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

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

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

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

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

            
2591
You can check SQL.
2592

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2631
This is used to create where clause.
2632

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

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

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

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

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

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

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

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

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

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

            
2656
Create update parameter tag.
2657

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

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

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

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

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

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

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

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

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

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

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

            
2688
The following tags is available.
2689

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

            
2692
Table tag
2693

            
2694
    {table TABLE}    ->    TABLE
2695

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

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

            
2700
Placeholder tag.
2701

            
2702
    {? NAME}    ->   ?
2703

            
2704
=head2 C<=>
2705

            
2706
Equal tag.
2707

            
2708
    {= NAME}    ->   NAME = ?
2709

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

            
2712
Not equal tag.
2713

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

            
2716
=head2 C<E<lt>>
2717

            
2718
Lower than tag
2719

            
2720
    {< NAME}    ->   NAME < ?
2721

            
2722
=head2 C<E<gt>>
2723

            
2724
Greater than tag
2725

            
2726
    {> NAME}    ->   NAME > ?
2727

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

            
2730
Greater than or equal tag
2731

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

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

            
2736
Lower than or equal tag
2737

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

            
2740
=head2 C<like>
2741

            
2742
Like tag
2743

            
2744
    {like NAME}   ->   NAME like ?
2745

            
2746
=head2 C<in>
2747

            
2748
In tag.
2749

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

            
2752
=head2 C<insert_param>
2753

            
2754
Insert parameter tag.
2755

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

            
2758
=head2 C<update_param>
2759

            
2760
Updata parameter tag.
2761

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

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

            
2766
=head2 C<DBIX_CUSTOM_DEBUG>
2767

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2797