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

            
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
3
our $VERSION = '0.1678';
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 {
improved error messages
Yuki Kimoto authored on 2011-04-18
81
        croak qq{Can't locate object method "$mname" via "$package"}
82
            . qq{ (DBIx::Custom::AUTOLOAD)}
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
83
    }
added helper method
yuki-kimoto authored on 2010-10-17
84
}
85

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
244
sub dbh {
245
    my $self = shift;
cleanup
Yuki Kimoto authored on 2011-04-02
246
    
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
247
    # Set
248
    if (@_) {
249
        $self->{dbh} = $_[0];
250
        
251
        return $self;
252
    }
253
    
254
    # Get
255
    else {
256
        # From Connction manager
257
        if (my $connector = $self->connector) {
258
            croak "connector must have dbh() method"
improved error messages
Yuki Kimoto authored on 2011-04-18
259
                . " (DBIx::Custom::dbh)"
fixed dbh() method bug:wq
Yuki Kimoto authored on 2011-04-05
260
              unless ref $connector && $connector->can('dbh');
261
              
262
            return $self->{dbh} = $connector->dbh;
263
        }
264
        
265
        return $self->{dbh} ||= $self->_connect;
update pod
Yuki Kimoto authored on 2011-03-13
266
    }
267
}
268

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
537
        return $result;
538
    }
cleanup
Yuki Kimoto authored on 2011-04-02
539
    
540
    # Not select statement
541
    else { return $affected }
cleanup
yuki-kimoto authored on 2010-10-17
542
}
543

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

            
cleanup
yuki-kimoto authored on 2010-10-17
546
sub insert {
547
    my ($self, %args) = @_;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
548
    
cleanup
yuki-kimoto authored on 2010-10-17
549
    # Arguments
cleanup
Yuki Kimoto authored on 2011-03-21
550
    my $table  = delete $args{table};
improved error messages
Yuki Kimoto authored on 2011-04-18
551
    croak qq{"table" option must be specified (DBIx::Custom::insert)}
552
      unless $table;
cleanup
Yuki Kimoto authored on 2011-03-21
553
    my $param  = delete $args{param} || {};
554
    my $append = delete $args{append} || '';
cleanup
Yuki Kimoto authored on 2011-04-02
555
    my $query_return  = delete $args{query};
556

            
557
    # Check arguments
558
    foreach my $name (keys %args) {
improved error messages
Yuki Kimoto authored on 2011-04-18
559
        croak qq{"$name" is wrong option (DBIx::Custom::insert)}
cleanup
Yuki Kimoto authored on 2011-04-02
560
          unless $INSERT_ARGS{$name};
561
    }
562

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

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

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

            
602
    # Arguments
603
    my $primary_keys = delete $args{primary_key};
604
    $primary_keys = [$primary_keys] unless ref $primary_keys;
605
    my $where = delete $args{where};
606
    my $param = delete $args{param};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
607
    
cleanup
Yuki Kimoto authored on 2011-04-02
608
    # Check arguments
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
609
    foreach my $name (keys %args) {
improved error messages
Yuki Kimoto authored on 2011-04-18
610
        croak qq{"$name" is wrong option (DBIx::Custom::insert_at)}
cleanup
Yuki Kimoto authored on 2011-03-21
611
          unless $INSERT_AT_ARGS{$name};
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
612
    }
613
    
cleanup
Yuki Kimoto authored on 2011-04-02
614
    # Create where parameter
615
    my $where_param = $self->_create_where_param($where, $primary_keys);
cleanup
Yuki Kimoto authored on 2011-04-02
616
    $param = $self->merge_param($where_param, $param);
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
617
    
618
    return $self->insert(param => $param, %args);
619
}
620

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
621
sub insert_param_tag {
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
622
    my ($self, $param) = @_;
623
    
cleanup
Yuki Kimoto authored on 2011-04-02
624
    # Create insert parameter tag
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
625
    my $safety = $self->safety_character;
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
626
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-04-02
627
    my @columns;
628
    my @placeholders;
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
629
    foreach my $column (keys %$param) {
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
630
        croak qq{"$column" is not safety column name}
improved error messages
Yuki Kimoto authored on 2011-04-18
631
            . qq{ (DBIx::Custom::insert_param_tag) }
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
632
          unless $column =~ /^[$safety\.]+$/;
cleanup
Yuki Kimoto authored on 2011-04-02
633
        $column = "$q$column$q";
634
        $column =~ s/\./$q.$q/;
635
        push @columns, $column;
636
        push @placeholders, "{? $column}";
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
637
    }
638
    
cleanup
Yuki Kimoto authored on 2011-04-02
639
    return '(' . join(', ', @columns) . ') ' . 'values ' .
640
           '(' . join(', ', @placeholders) . ')'
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
641
}
642

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
643
sub include_model {
644
    my ($self, $name_space, $model_infos) = @_;
645
    
cleanup
Yuki Kimoto authored on 2011-04-02
646
    # Name space
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
647
    $name_space ||= '';
cleanup
Yuki Kimoto authored on 2011-04-02
648
    
649
    # Get Model infomations
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
650
    unless ($model_infos) {
cleanup
Yuki Kimoto authored on 2011-04-02
651

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

            
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
711
sub merge_param {
712
    my ($self, @params) = @_;
713
    
cleanup
Yuki Kimoto authored on 2011-04-02
714
    # Merge parameters
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
715
    my $param = {};
716
    foreach my $p (@params) {
717
        foreach my $column (keys %$p) {
718
            if (exists $param->{$column}) {
719
                $param->{$column} = [$param->{$column}]
720
                  unless ref $param->{$column} eq 'ARRAY';
721
                push @{$param->{$column}}, $p->{$column};
722
            }
723
            else {
724
                $param->{$column} = $p->{$column};
725
            }
726
        }
727
    }
728
    
729
    return $param;
730
}
731

            
cleanup
Yuki Kimoto authored on 2011-03-21
732
sub method {
733
    my $self = shift;
734
    
cleanup
Yuki Kimoto authored on 2011-04-02
735
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
736
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
737
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
738
    
739
    return $self;
740
}
741

            
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
742
sub model {
743
    my ($self, $name, $model) = @_;
744
    
cleanup
Yuki Kimoto authored on 2011-04-02
745
    # Set model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
746
    if ($model) {
747
        $self->models->{$name} = $model;
748
        return $self;
749
    }
750
    
751
    # Check model existance
improved error messages
Yuki Kimoto authored on 2011-04-18
752
    croak qq{Model "$name" is not included (DBIx::Custom::model)}
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
753
      unless $self->models->{$name};
754
    
cleanup
Yuki Kimoto authored on 2011-04-02
755
    # Get model
- added EXPERIMENTAL DBIx::C...
Yuki Kimoto authored on 2011-03-15
756
    return $self->models->{$name};
757
}
758

            
cleanup
Yuki Kimoto authored on 2011-03-21
759
sub mycolumn {
760
    my ($self, $table, $columns) = @_;
761
    
cleanup
Yuki Kimoto authored on 2011-04-02
762
    # Create column clause
763
    my @column;
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
764
    my $q = $self->reserved_word_quote;
cleanup
Yuki Kimoto authored on 2011-03-21
765
    $columns ||= [];
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
766
    push @column, "$q$table$q.$q$_$q as $q$_$q" for @$columns;
cleanup
Yuki Kimoto authored on 2011-03-21
767
    
768
    return join (', ', @column);
769
}
770

            
added dbi_options attribute
kimoto authored on 2010-12-20
771
sub new {
772
    my $self = shift->SUPER::new(@_);
773
    
cleanup
Yuki Kimoto authored on 2011-04-02
774
    # Check attributes
added dbi_options attribute
kimoto authored on 2010-12-20
775
    my @attrs = keys %$self;
776
    foreach my $attr (@attrs) {
improved error messages
Yuki Kimoto authored on 2011-04-18
777
        croak qq{"$attr" is wrong name (DBIx::Custom::new)}
added dbi_options attribute
kimoto authored on 2010-12-20
778
          unless $self->can($attr);
779
    }
cleanup
Yuki Kimoto authored on 2011-04-02
780
    
781
    # Register tag
cleanup
Yuki Kimoto authored on 2011-01-25
782
    $self->register_tag(
783
        '?'     => \&DBIx::Custom::Tag::placeholder,
784
        '='     => \&DBIx::Custom::Tag::equal,
785
        '<>'    => \&DBIx::Custom::Tag::not_equal,
786
        '>'     => \&DBIx::Custom::Tag::greater_than,
787
        '<'     => \&DBIx::Custom::Tag::lower_than,
788
        '>='    => \&DBIx::Custom::Tag::greater_than_equal,
789
        '<='    => \&DBIx::Custom::Tag::lower_than_equal,
790
        'like'  => \&DBIx::Custom::Tag::like,
791
        'in'    => \&DBIx::Custom::Tag::in,
792
        'insert_param' => \&DBIx::Custom::Tag::insert_param,
793
        'update_param' => \&DBIx::Custom::Tag::update_param
794
    );
added dbi_options attribute
kimoto authored on 2010-12-20
795
    
796
    return $self;
797
}
798

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

            
cleanup
yuki-kimoto authored on 2010-10-17
801
sub register_filter {
cleanup
Yuki Kimoto authored on 2011-04-02
802
    my $self = shift;
cleanup
yuki-kimoto authored on 2010-10-17
803
    
804
    # Register filter
805
    my $filters = ref $_[0] eq 'HASH' ? $_[0] : {@_};
cleanup
Yuki Kimoto authored on 2011-04-02
806
    $self->filters({%{$self->filters}, %$filters});
cleanup
yuki-kimoto authored on 2010-10-17
807
    
cleanup
Yuki Kimoto authored on 2011-04-02
808
    return $self;
cleanup
yuki-kimoto authored on 2010-10-17
809
}
packaging one directory
yuki-kimoto authored on 2009-11-16
810

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1058
sub _create_where_param {
1059
    my ($self, $where, $primary_keys) = @_;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
1060
    
cleanup
Yuki Kimoto authored on 2011-04-02
1061
    # Create where parameter
1062
    my $where_param = {};
1063
    if ($where) {
1064
        $where = [$where] unless ref $where;
1065
        croak qq{"where" must be constant value or array reference}
improved error messages
Yuki Kimoto authored on 2011-04-18
1066
            . " (" . (caller 1)[3] . ")"
cleanup
Yuki Kimoto authored on 2011-04-02
1067
          unless !ref $where || ref $where eq 'ARRAY';
improved error messages
Yuki Kimoto authored on 2011-04-18
1068
        
1069
        croak qq{"where" must contain values same count as primary key}
1070
            . " (" . (caller 1)[3] . ")"
1071
          unless @$primary_keys eq @$where;
1072
        
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1073
        for(my $i = 0; $i < @$primary_keys; $i ++) {
cleanup
Yuki Kimoto authored on 2011-04-02
1074
           $where_param->{$primary_keys->[$i]} = $where->[$i];
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1075
        }
1076
    }
1077
    
cleanup
Yuki Kimoto authored on 2011-04-02
1078
    return $where_param;
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1079
}
1080

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

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

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

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

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

            
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1207
sub _need_tables {
1208
    my ($self, $tree, $need_tables, $tables) = @_;
1209
    
cleanup
Yuki Kimoto authored on 2011-04-02
1210
    # Get needed tables
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
1211
    foreach my $table (@$tables) {
1212
        if ($tree->{$table}) {
1213
            $need_tables->{$table} = 1;
1214
            $self->_need_tables($tree, $need_tables, [$tree->{$table}{parent}])
1215
        }
1216
    }
1217
}
1218

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
1259
sub _remove_duplicate_table {
1260
    my ($self, $tables, $main_table) = @_;
1261
    
1262
    # Remove duplicate table
1263
    my %tables = map {defined $_ ? ($_ => 1) : ()} @$tables;
1264
    delete $tables{$main_table} if $main_table;
1265
    
1266
    return [keys %tables, $main_table ? $main_table : ()];
1267
}
1268

            
cleanup
Yuki Kimoto authored on 2011-04-02
1269
sub _search_tables {
cleanup
Yuki Kimoto authored on 2011-04-02
1270
    my ($self, $source) = @_;
1271
    
cleanup
Yuki Kimoto authored on 2011-04-02
1272
    # Search tables
cleanup
Yuki Kimoto authored on 2011-04-02
1273
    my $tables = [];
1274
    my $safety_character = $self->safety_character;
1275
    my $q = $self->reserved_word_quote;
1276
    my $q_re = quotemeta($q);
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1277
    my $table_re = $q ? qr/(?:^|[^$safety_character])$q_re?([$safety_character]+)$q_re?\./
1278
                      : qr/(?:^|[^$safety_character])([$safety_character]+)\./;
cleanup
Yuki Kimoto authored on 2011-04-02
1279
    while ($source =~ /$table_re/g) {
1280
        push @$tables, $1;
1281
    }
1282
    
1283
    return $tables;
1284
}
1285

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1327
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-23
1328
__PACKAGE__->attr(
1329
    dbi_options => sub { {} },
1330
    filter_check  => 1
1331
);
renamed dbi_options to dbi_o...
Yuki Kimoto authored on 2011-01-23
1332

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
1355
# DEPRECATED!
cleanup
Yuki Kimoto authored on 2011-01-12
1356
sub default_fetch_filter {
1357
    my $self = shift;
1358
    
1359
    if (@_) {
many changed
Yuki Kimoto authored on 2011-01-23
1360
        my $fname = $_[0];
1361

            
cleanup
Yuki Kimoto authored on 2011-01-12
1362
        if (@_ && !$fname) {
1363
            $self->{default_in_filter} = undef;
1364
        }
1365
        else {
many changed
Yuki Kimoto authored on 2011-01-23
1366
            croak qq{Filter "$fname" is not registered}
cleanup
Yuki Kimoto authored on 2011-01-12
1367
              unless exists $self->filters->{$fname};
1368
        
1369
            $self->{default_in_filter} = $self->filters->{$fname};
1370
        }
1371
        
1372
        return $self;
1373
    }
1374
    
many changed
Yuki Kimoto authored on 2011-01-23
1375
    return $self->{default_in_filter};
cleanup
Yuki Kimoto authored on 2011-01-12
1376
}
1377

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
1378
# DEPRECATED!
1379
sub insert_param {
1380
    warn "insert_param is renamed to insert_param_tag."
1381
       . " insert_param is DEPRECATED!";
1382
    return shift->insert_param_tag(@_);
1383
}
1384

            
cleanup
Yuki Kimoto authored on 2011-01-25
1385
# DEPRECATED!
renamed DBIx::Custom::TagPro...
Yuki Kimoto authored on 2011-01-24
1386
sub register_tag_processor {
1387
    return shift->query_builder->register_tag_processor(@_);
1388
}
1389

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1434
=head1 NAME
1435

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

            
1438
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1439

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

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

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

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

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

            
1507
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1508

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1519
=item *
1520

            
1521
Filter when data is send or receive.
1522

            
1523
=item *
1524

            
1525
Data filtering system
1526

            
1527
=item *
1528

            
1529
Model support.
1530

            
1531
=item *
1532

            
1533
Generate where clause dinamically.
1534

            
1535
=item *
1536

            
1537
Generate join clause dinamically.
1538

            
1539
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1540

            
1541
=head1 GUIDE
1542

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1551
=head2 C<connector>
- removed EXPERIMENTAL Prefo...
Yuki Kimoto authored on 2011-04-04
1552

            
1553
    my $connector = $dbi->connector;
1554
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1555

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

            
1559
This is L<DBIx::Connector> example. Please pass
1560
C<default_dbi_option> to L<DBIx::Connector>.
1561

            
1562
    my $connector = DBIx::Connector->new(
1563
        "dbi:mysql:database=$DATABASE",
1564
        $USER,
1565
        $PASSWORD,
1566
        DBIx::Custom->new->default_dbi_option
1567
    );
1568
    
1569
    my $dbi = DBIx::Custom->new(connector => $connector);
1570

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

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

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

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

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

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

            
1586
=head2 C<default_dbi_option>
1587

            
1588
    my $default_dbi_option = $dbi->default_dbi_option;
1589
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1590

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1594
    {
1595
        RaiseError => 1,
1596
        PrintError => 0,
1597
        AutoCommit => 1,
1598
    }
packaging one directory
yuki-kimoto authored on 2009-11-16
1599

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1610
=head2 C<models>
add models() attribute
Yuki Kimoto authored on 2011-02-21
1611

            
1612
    my $models = $dbi->models;
1613
    $dbi       = $dbi->models(\%models);
1614

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1617
=head2 C<password>
1618

            
1619
    my $password = $dbi->password;
1620
    $dbi         = $dbi->password('lkj&le`@s');
1621

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

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1631
=head2 C<reserved_word_quote>
added EXPERIMENTAL reserved_...
Yuki Kimoto authored on 2011-03-30
1632

            
1633
     my reserved_word_quote = $dbi->reserved_word_quote;
1634
     $dbi                   = $dbi->reserved_word_quote('"');
1635

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1655
    my $user = $dbi->user;
1656
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1657

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1666
=head2 C<apply_filter>
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1667

            
renamed auto_filter to apply...
Yuki Kimoto authored on 2011-01-12
1668
    $dbi->apply_filter(
cleanup
Yuki Kimoto authored on 2011-03-10
1669
        'book',
update pod
Yuki Kimoto authored on 2011-03-13
1670
        'issue_date' => {
1671
            out => 'tp_to_date',
1672
            in  => 'date_to_tp',
1673
            end => 'tp_to_displaydate'
1674
        },
1675
        'write_date' => {
1676
            out => 'tp_to_date',
1677
            in  => 'date_to_tp',
1678
            end => 'tp_to_displaydate'
1679
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
1680
    );
1681

            
update pod
Yuki Kimoto authored on 2011-03-13
1682
Apply filter to columns.
1683
C<out> filter is executed before data is send to database.
1684
C<in> filter is executed after a row is fetch.
1685
C<end> filter is execute after C<in> filter is executed.
1686

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1689
       PETTERN         EXAMPLE
1690
    1. Column        : author
1691
    2. Table.Column  : book.author
1692
    3. Table__Column : book__author
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1693

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

            
1697
You can set multiple filters at once.
1698

            
1699
    $dbi->apply_filter(
1700
        'book',
1701
        [qw/issue_date write_date/] => {
1702
            out => 'tp_to_date',
1703
            in  => 'date_to_tp',
1704
            end => 'tp_to_displaydate'
1705
        }
1706
    );
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
1707

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1710
    my $dbi = DBIx::Custom->connect(
1711
        data_source => "dbi:mysql:database=dbname",
1712
        user => 'ken',
1713
        password => '!LFKD%$&',
1714
        dbi_option => {mysql_enable_utf8 => 1}
1715
    );
1716

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

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

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

            
adeed EXPERIMENTAL DBIx::Cus...
Yuki Kimoto authored on 2011-03-29
1725
    my $model = $dbi->create_model(
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1726
        table => 'book',
1727
        primary_key => 'id',
1728
        join => [
1729
            'inner join company on book.comparny_id = company.id'
1730
        ],
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1731
        filter => {
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1732
            publish_date => {
1733
                out => 'tp_to_date',
1734
                in => 'date_to_tp',
1735
                end => 'tp_to_displaydate'
1736
            }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1737
        }
removed EXPERIMETNAL flag fr...
Yuki Kimoto authored on 2011-03-25
1738
    );
1739

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

            
1743
   $dbi->model('book')->select(...);
1744

            
cleanup
yuki-kimoto authored on 2010-10-17
1745
=head2 C<create_query>
1746
    
1747
    my $query = $dbi->create_query(
update pod
Yuki Kimoto authored on 2011-03-13
1748
        "insert into book {insert_param title author};";
cleanup
yuki-kimoto authored on 2010-10-17
1749
    );
update document
yuki-kimoto authored on 2009-11-19
1750

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

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

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

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

            
1761
    my $dbh = $dbi->dbh;
1762

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

            
1766
=head2 C<each_column>
1767

            
1768
    $dbi->each_column(
1769
        sub {
1770
            my ($dbi, $table, $column, $column_info) = @_;
1771
            
1772
            my $type = $column_info->{TYPE_NAME};
1773
            
1774
            if ($type eq 'DATE') {
1775
                # ...
1776
            }
1777
        }
1778
    );
1779

            
1780
Iterate all column informations of all table from database.
1781
Argument is callback when one column is found.
1782
Callback receive four arguments, dbi object, table name,
1783
column name and column information.
EXPERIMETAL fork safety impl...
Yuki Kimoto authored on 2011-03-12
1784

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1787
    my $result = $dbi->execute(
1788
        "select * from book where {= title} and {like author}",
1789
        param => {title => 'Perl', author => '%Ken%'}
1790
    );
1791

            
1792
Execute SQL, containing tags.
1793
Return value is L<DBIx::Custom::Result> in select statement, or
1794
the count of affected rows in insert, update, delete statement.
1795

            
1796
Tag is turned into the statement containing place holder
1797
before SQL is executed.
1798

            
1799
    select * from where title = ? and author like ?;
1800

            
1801
See also L<Tags/Tags>.
1802

            
1803
The following opitons are currently available.
1804

            
1805
=over 4
1806

            
improved table search in col...
Yuki Kimoto authored on 2011-04-12
1807
=item C<table>
1808

            
1809
Table names for filtering.
1810

            
1811
    $dbi->execute(table => ['author', 'book']);
1812

            
1813
C<execute()> is unlike C<insert()>, C<update()>, C<delete()>, C<select(),
1814
Filtering is off because we don't know what filter is applied.
1815

            
1816

            
1817

            
1818

            
1819

            
1820

            
update pod
Yuki Kimoto authored on 2011-03-13
1821
=item C<filter>
1822

            
1823
Filter, executed before data is send to database. This is array reference.
1824
Filter value is code reference or
1825
filter name registerd by C<register_filter()>.
1826

            
1827
    # Basic
1828
    $dbi->execute(
1829
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1830
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1831
            title  => sub { uc $_[0] }
1832
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1833
        }
update pod
Yuki Kimoto authored on 2011-03-13
1834
    );
1835
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1836
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1837
    $dbi->execute(
1838
        $sql,
1839
        filter => [
1840
            [qw/title author/]  => sub { uc $_[0] }
1841
        ]
1842
    );
1843
    
1844
    # Filter name
1845
    $dbi->execute(
1846
        $sql,
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1847
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1848
            title  => 'upper_case',
1849
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1850
        }
update pod
Yuki Kimoto authored on 2011-03-13
1851
    );
1852

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

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

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

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

            
1861
Delete statement.
1862

            
1863
The following opitons are currently available.
1864

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

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

            
1869
Table name.
1870

            
1871
    $dbi->delete(table => 'book');
1872

            
1873
=item C<where>
1874

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1875
Where clause. This is hash reference or L<DBIx::Custom::Where> object
1876
or array refrence, which contains where clause and paramter.
update pod
Yuki Kimoto authored on 2011-03-13
1877
    
1878
    # Hash reference
1879
    $dbi->delete(where => {title => 'Perl'});
1880
    
1881
    # DBIx::Custom::Where object
1882
    my $where = $dbi->where(
1883
        clause => ['and', '{= author}', '{like title}'],
1884
        param  => {author => 'Ken', title => '%Perl%'}
1885
    );
1886
    $dbi->delete(where => $where);
1887

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
1888
    # Array refrendce (where clause and parameter)
1889
    $dbi->delete(where =>
1890
        [
1891
            ['and', '{= author}', '{like title}'],
1892
            {author => 'Ken', title => '%Perl%'}
1893
        ]
1894
    );
1895
    
update pod
Yuki Kimoto authored on 2011-03-13
1896
=item C<append>
1897

            
1898
Append statement to last of SQL. This is string.
1899

            
1900
    $dbi->delete(append => 'order by title');
1901

            
1902
=item C<filter>
1903

            
1904
Filter, executed before data is send to database. This is array reference.
1905
Filter value is code reference or
1906
filter name registerd by C<register_filter()>.
1907

            
1908
    # Basic
1909
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1910
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1911
            title  => sub { uc $_[0] }
1912
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1913
        }
update pod
Yuki Kimoto authored on 2011-03-13
1914
    );
1915
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1916
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
1917
    $dbi->delete(
1918
        filter => [
1919
            [qw/title author/]  => sub { uc $_[0] }
1920
        ]
1921
    );
1922
    
1923
    # Filter name
1924
    $dbi->delete(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1925
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
1926
            title  => 'upper_case',
1927
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
1928
        }
update pod
Yuki Kimoto authored on 2011-03-13
1929
    );
1930

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
1933
=head2 C<column>
cleanup
Yuki Kimoto authored on 2011-03-21
1934

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

            
1937
Create column clause. The follwoing column clause is created.
1938

            
1939
    book.author as book__author,
1940
    book.title as book__title
1941

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

            
1944
Get L<DBIx::Custom::Query> object instead of executing SQL.
1945
This is true or false value.
1946

            
1947
    my $query = $dbi->delete(query => 1);
1948

            
1949
You can check SQL.
1950

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1953
=back
1954

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

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

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

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

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

            
1966
    $dbi->delete_at(
1967
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
1968
        primary_key => 'id',
1969
        where => '5'
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
1970
    );
1971

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1980
Primary key. This is constant value or array reference.
1981
    
1982
    # Constant value
1983
    $dbi->delete(primary_key => 'id');
1984

            
1985
    # Array reference
1986
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1987

            
1988
This is used to create where clause.
1989

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

            
1992
Where clause, created from primary key information.
1993
This is constant value or array reference.
1994

            
1995
    # Constant value
1996
    $dbi->delete(where => 5);
1997

            
1998
    # Array reference
1999
    $dbi->delete(where => [3, 5]);
2000

            
2001
In first examle, the following SQL is created.
2002

            
2003
    delete from book where id = ?;
2004

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2007
=back
2008

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2011
    $dbi->insert(
2012
        table  => 'book', 
2013
        param  => {title => 'Perl', author => 'Ken'}
2014
    );
2015

            
2016
Insert statement.
2017

            
2018
The following opitons are currently available.
2019

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

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

            
2024
Table name.
2025

            
2026
    $dbi->insert(table => 'book');
2027

            
2028
=item C<param>
2029

            
2030
Insert data. This is hash reference.
2031

            
2032
    $dbi->insert(param => {title => 'Perl'});
2033

            
2034
=item C<append>
2035

            
2036
Append statement to last of SQL. This is string.
2037

            
2038
    $dbi->insert(append => 'order by title');
2039

            
2040
=item C<filter>
2041

            
2042
Filter, executed before data is send to database. This is array reference.
2043
Filter value is code reference or
2044
filter name registerd by C<register_filter()>.
2045

            
2046
    # Basic
2047
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2048
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2049
            title  => sub { uc $_[0] }
2050
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2051
        }
update pod
Yuki Kimoto authored on 2011-03-13
2052
    );
2053
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2054
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2055
    $dbi->insert(
2056
        filter => [
2057
            [qw/title author/]  => sub { uc $_[0] }
2058
        ]
2059
    );
2060
    
2061
    # Filter name
2062
    $dbi->insert(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2063
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2064
            title  => 'upper_case',
2065
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2066
        }
update pod
Yuki Kimoto authored on 2011-03-13
2067
    );
2068

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

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

            
2073
Get L<DBIx::Custom::Query> object instead of executing SQL.
2074
This is true or false value.
2075

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2082
=back
2083

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

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

            
2088
    $dbi->insert_at(
2089
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2090
        primary_key => 'id',
2091
        where => '5',
2092
        param => {title => 'Perl'}
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-02-28
2093
    );
2094

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

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

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

            
2103
Primary key. This is constant value or array reference.
2104
    
2105
    # Constant value
2106
    $dbi->insert(primary_key => 'id');
2107

            
2108
    # Array reference
2109
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2110

            
2111
This is used to create parts of insert data.
2112

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

            
2115
Parts of Insert data, create from primary key information.
2116
This is constant value or array reference.
2117

            
2118
    # Constant value
2119
    $dbi->insert(where => 5);
2120

            
2121
    # Array reference
2122
    $dbi->insert(where => [3, 5]);
2123

            
2124
In first examle, the following SQL is created.
2125

            
2126
    insert into book (id, title) values (?, ?);
2127

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2130
=back
2131

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

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

            
2136
Create insert parameter tag.
2137

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2140
=head2 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
    $dbi->include_model('MyModel');
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2143

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2147
    lib / MyModel.pm
2148
        / MyModel / book.pm
2149
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2150

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

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

            
2155
    package MyModel;
2156
    
2157
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2158
    
2159
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2160

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2165
    package MyModel::book;
2166
    
2167
    use base 'MyModel';
2168
    
2169
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2170

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2173
    package MyModel::company;
2174
    
2175
    use base 'MyModel';
2176
    
2177
    1;
2178
    
2179
MyModel::book and MyModel::company is included by C<include_model()>.
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2180

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

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

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2188
=head2 C<merge_param>
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2189

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

            
2192
Merge paramters.
2193

            
2194
$param:
2195

            
2196
    {key1 => [1, 1], key2 => 2}
2197

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2198
=head2 C<method>
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2199

            
2200
    $dbi->method(
2201
        update_or_insert => sub {
2202
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2203
            
2204
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2205
        },
2206
        find_or_create   => sub {
2207
            my $self = shift;
update pod
Yuki Kimoto authored on 2011-03-13
2208
            
2209
            # Process
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2210
        }
2211
    );
2212

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

            
2215
    $dbi->update_or_insert;
2216
    $dbi->find_or_create;
2217

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2218
=head2 C<model>
update pod
Yuki Kimoto authored on 2011-03-13
2219

            
2220
    $dbi->model('book')->method(
2221
        insert => sub { ... },
2222
        update => sub { ... }
2223
    );
2224
    
2225
    my $model = $dbi->model('book');
2226

            
2227
Set and get a L<DBIx::Custom::Model> object,
2228

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2229
=head2 C<mycolumn>
cleanup
Yuki Kimoto authored on 2011-03-21
2230

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

            
2233
Create column clause for myself. The follwoing column clause is created.
2234

            
2235
    book.author as author,
2236
    book.title as title
2237

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2240
    my $dbi = DBIx::Custom->new(
2241
        data_source => "dbi:mysql:database=dbname",
2242
        user => 'ken',
2243
        password => '!LFKD%$&',
2244
        dbi_option => {mysql_enable_utf8 => 1}
2245
    );
added experimental not_exist...
Yuki Kimoto authored on 2011-01-26
2246

            
2247
Create a new L<DBIx::Custom> object.
2248

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

            
2251
    my $not_exists = $dbi->not_exists;
2252

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2256
=head2 C<register_filter>
2257

            
update pod
Yuki Kimoto authored on 2011-03-13
2258
    $dbi->register_filter(
2259
        # Time::Piece object to database DATE format
2260
        tp_to_date => sub {
2261
            my $tp = shift;
2262
            return $tp->strftime('%Y-%m-%d');
2263
        },
2264
        # database DATE format to Time::Piece object
2265
        date_to_tp => sub {
2266
           my $date = shift;
2267
           return Time::Piece->strptime($date, '%Y-%m-%d');
2268
        }
2269
    );
cleanup
yuki-kimoto authored on 2010-10-17
2270
    
update pod
Yuki Kimoto authored on 2011-03-13
2271
Register filters, used by C<filter> option of many methods.
cleanup
yuki-kimoto authored on 2010-10-17
2272

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2275
    $dbi->register_tag(
2276
        update => sub {
2277
            my @columns = @_;
2278
            
2279
            # Update parameters
2280
            my $s = 'set ';
2281
            $s .= "$_ = ?, " for @columns;
2282
            $s =~ s/, $//;
2283
            
2284
            return [$s, \@columns];
2285
        }
2286
    );
cleanup
yuki-kimoto authored on 2010-10-17
2287

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

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
2311
    my $result = $dbi->select(
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2312
        table  => 'book',
2313
        column => ['author', 'title'],
2314
        where  => {author => 'Ken'},
select method column option ...
Yuki Kimoto authored on 2011-02-22
2315
    );
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2316
    
update pod
Yuki Kimoto authored on 2011-03-12
2317
Select statement.
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2318

            
2319
The following opitons are currently available.
2320

            
2321
=over 4
2322

            
2323
=item C<table>
2324

            
2325
Table name.
2326

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

            
2329
=item C<column>
2330

            
2331
Column clause. This is array reference or constant value.
2332

            
2333
    # Hash refernce
2334
    $dbi->select(column => ['author', 'title']);
2335
    
2336
    # Constant value
2337
    $dbi->select(column => 'author');
2338

            
2339
Default is '*' unless C<column> is specified.
2340

            
2341
    # Default
2342
    $dbi->select(column => '*');
2343

            
2344
=item C<where>
2345

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

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2359
    # Array refrendce (where clause and parameter)
2360
    $dbi->select(where =>
2361
        [
2362
            ['and', '{= author}', '{like title}'],
2363
            {author => 'Ken', title => '%Perl%'}
2364
        ]
2365
    );
2366
    
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2367
=item C<join>
added select() all_column op...
Yuki Kimoto authored on 2011-03-12
2368

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

            
2371
    $dbi->select(join =>
2372
        [
2373
            'left outer join company on book.company_id = company_id',
2374
            'left outer join location on company.location_id = location.id'
2375
        ]
2376
    );
2377

            
2378
If column cluase or where clause contain table name like "company.name",
2379
needed join clause is used automatically.
2380

            
2381
    $dbi->select(
2382
        table => 'book',
2383
        column => ['company.location_id as company__location_id'],
2384
        where => {'company.name' => 'Orange'},
2385
        join => [
2386
            'left outer join company on book.company_id = company.id',
2387
            'left outer join location on company.location_id = location.id'
2388
        ]
2389
    );
2390

            
2391
In above select, the following SQL is created.
2392

            
2393
    select company.location_id as company__location_id
2394
    from book
2395
      left outer join company on book.company_id = company.id
2396
    where company.name = Orange
2397

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

            
2400
Parameter shown before where clause.
2401
    
2402
    $dbi->select(
2403
        table => 'table1',
2404
        column => 'table1.key1 as table1_key1, key2, key3',
2405
        where   => {'table1.key2' => 3},
2406
        join  => ['inner join (select * from table2 where {= table2.key3})' . 
2407
                  ' as table2 on table1.key1 = table2.key1'],
2408
        param => {'table2.key3' => 5}
2409
    );
2410

            
2411
For example, if you want to contain tag in join clause, 
2412
you can pass parameter by C<param> option.
2413

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

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

            
2418
    $dbi->select(append => 'order by title');
2419

            
2420
=item C<filter>
2421

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

            
2426
    # Basic
2427
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2428
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2429
            title  => sub { uc $_[0] }
2430
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2431
        }
update pod
Yuki Kimoto authored on 2011-03-12
2432
    );
2433
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2434
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2435
    $dbi->select(
2436
        filter => [
2437
            [qw/title author/]  => sub { uc $_[0] }
2438
        ]
2439
    );
2440
    
2441
    # Filter name
2442
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2443
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2444
            title  => 'upper_case',
2445
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2446
        }
update pod
Yuki Kimoto authored on 2011-03-12
2447
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2448

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

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

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

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

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

            
2460
    my $sql = $query->sql;
2461

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2462
=item C<type>
- added EXPERIMENTAL type() ...
Yuki Kimoto authored on 2011-03-21
2463

            
2464
Specify database data type.
2465

            
2466
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2467
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2468

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

            
2471
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2472

            
update pod
Yuki Kimoto authored on 2011-03-12
2473
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2474

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

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

            
2479
    $dbi->select_at(
2480
        table => 'book',
2481
        primary_key => 'id',
2482
        where => '5'
2483
    );
2484

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2493
Primary key. This is constant value or array reference.
2494
    
2495
    # Constant value
2496
    $dbi->select(primary_key => 'id');
2497

            
2498
    # Array reference
2499
    $dbi->select(primary_key => ['id1', 'id2' ]);
2500

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

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

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

            
2508
    # Constant value
2509
    $dbi->select(where => 5);
2510

            
2511
    # Array reference
2512
    $dbi->select(where => [3, 5]);
2513

            
2514
In first examle, the following SQL is created.
2515

            
2516
    select * from book where id = ?
2517

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2520
=back
2521

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2524
    $dbi->update(
2525
        table  => 'book',
2526
        param  => {title => 'Perl'},
2527
        where  => {id => 4}
2528
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2529

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2538
Table name.
2539

            
2540
    $dbi->update(table => 'book');
2541

            
2542
=item C<param>
2543

            
2544
Update data. This is hash reference.
2545

            
2546
    $dbi->update(param => {title => 'Perl'});
2547

            
2548
=item C<where>
2549

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2550
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2551
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2552
    
2553
    # Hash reference
2554
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2555
    
2556
    # DBIx::Custom::Where object
2557
    my $where = $dbi->where(
2558
        clause => ['and', '{= author}', '{like title}'],
2559
        param  => {author => 'Ken', title => '%Perl%'}
2560
    );
2561
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2562
    
2563
    # Array refrendce (where clause and parameter)
2564
    $dbi->update(where =>
2565
        [
2566
            ['and', '{= author}', '{like title}'],
2567
            {author => 'Ken', title => '%Perl%'}
2568
        ]
2569
    );
update pod
Yuki Kimoto authored on 2011-03-13
2570

            
2571
=item C<append>
2572

            
2573
Append statement to last of SQL. This is string.
2574

            
2575
    $dbi->update(append => 'order by title');
2576

            
2577
=item C<filter>
2578

            
2579
Filter, executed before data is send to database. This is array reference.
2580
Filter value is code reference or
2581
filter name registerd by C<register_filter()>.
2582

            
2583
    # Basic
2584
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2585
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2586
            title  => sub { uc $_[0] }
2587
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2588
        }
update pod
Yuki Kimoto authored on 2011-03-13
2589
    );
2590
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2591
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2592
    $dbi->update(
2593
        filter => [
2594
            [qw/title author/]  => sub { uc $_[0] }
2595
        ]
2596
    );
2597
    
2598
    # Filter name
2599
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2600
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2601
            title  => 'upper_case',
2602
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2603
        }
update pod
Yuki Kimoto authored on 2011-03-13
2604
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2605

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

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

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

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

            
2615
You can check SQL.
2616

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

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

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

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

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

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

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

            
2632
    $dbi->update_at(
2633
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2634
        primary_key => 'id',
2635
        where => '5',
2636
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2637
    );
2638

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

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

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

            
2647
Primary key. This is constant value or array reference.
2648
    
2649
    # Constant value
2650
    $dbi->update(primary_key => 'id');
2651

            
2652
    # Array reference
2653
    $dbi->update(primary_key => ['id1', 'id2' ]);
2654

            
2655
This is used to create where clause.
2656

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

            
2659
Where clause, created from primary key information.
2660
This is constant value or array reference.
2661

            
2662
    # Constant value
2663
    $dbi->update(where => 5);
2664

            
2665
    # Array reference
2666
    $dbi->update(where => [3, 5]);
2667

            
2668
In first examle, the following SQL is created.
2669

            
2670
    update book set title = ? where id = ?
2671

            
2672
Place holders are set to 'Perl' and 5.
2673

            
update pod
Yuki Kimoto authored on 2011-03-13
2674
=back
2675

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

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

            
2680
Create update parameter tag.
2681

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2684
You can create tag without 'set '
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2685
by C<no_set> option.
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2686

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2687
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2688
        {title => 'a', age => 2}
2689
        {no_set => 1}
2690
    );
2691

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2696
    my $where = $dbi->where(
2697
        clause => ['and', '{= title}', '{= author}'],
2698
        param => {title => 'Perl', author => 'Ken'}
2699
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2700

            
2701
Create a new L<DBIx::Custom::Where> object.
2702

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2703
=head2 C<setup_model>
cleanup
Yuki Kimoto authored on 2011-01-12
2704

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2710
=head1 Tags
2711

            
2712
The following tags is available.
2713

            
2714
=head2 C<?>
2715

            
2716
Placeholder tag.
2717

            
2718
    {? NAME}    ->   ?
2719

            
2720
=head2 C<=>
2721

            
2722
Equal tag.
2723

            
2724
    {= NAME}    ->   NAME = ?
2725

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

            
2728
Not equal tag.
2729

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

            
2732
=head2 C<E<lt>>
2733

            
2734
Lower than tag
2735

            
2736
    {< NAME}    ->   NAME < ?
2737

            
2738
=head2 C<E<gt>>
2739

            
2740
Greater than tag
2741

            
2742
    {> NAME}    ->   NAME > ?
2743

            
2744
=head2 C<E<gt>=>
2745

            
2746
Greater than or equal tag
2747

            
2748
    {>= NAME}   ->   NAME >= ?
2749

            
2750
=head2 C<E<lt>=>
2751

            
2752
Lower than or equal tag
2753

            
2754
    {<= NAME}   ->   NAME <= ?
2755

            
2756
=head2 C<like>
2757

            
2758
Like tag
2759

            
2760
    {like NAME}   ->   NAME like ?
2761

            
2762
=head2 C<in>
2763

            
2764
In tag.
2765

            
2766
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2767

            
2768
=head2 C<insert_param>
2769

            
2770
Insert parameter tag.
2771

            
2772
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2773

            
2774
=head2 C<update_param>
2775

            
2776
Updata parameter tag.
2777

            
2778
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2779

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

            
2782
=head2 C<DBIX_CUSTOM_DEBUG>
2783

            
2784
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2785
executed SQL is printed to STDERR.
2786

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

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

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

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

            
2796
C<< <kimoto.yuki at gmail.com> >>
2797

            
2798
L<http://github.com/yuki-kimoto/DBIx-Custom>
2799

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2800
=head1 AUTHOR
2801

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

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

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

            
2808
This program is free software; you can redistribute it and/or modify it
2809
under the same terms as Perl itself.
2810

            
2811
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2812

            
2813