DBIx-Custom / lib / DBIx / Custom.pm /
Newer Older
2817 lines | 68.749kb
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

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

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

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

            
improved error messages
Yuki Kimoto authored on 2011-04-18
1137
sub _create_where_param {
1138
    my ($self, $where, $primary_keys) = @_;
1139
    
1140
    # Create where parameter
1141
    my $where_param = {};
1142
    if ($where) {
1143
        $where = [$where] unless ref $where;
1144
        croak qq{"where" must be constant value or array reference}
1145
            . " (" . (caller 1)[3] . ")"
1146
          unless !ref $where || ref $where eq 'ARRAY';
1147
        
1148
        croak qq{"where" must contain values same count as primary key}
1149
            . " (" . (caller 1)[3] . ")"
1150
          unless @$primary_keys eq @$where;
1151
        
1152
        for(my $i = 0; $i < @$primary_keys; $i ++) {
1153
           $where_param->{$primary_keys->[$i]} = $where->[$i];
1154
        }
1155
    }
1156
    
1157
    return $where_param;
1158
}
1159

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1438
=head1 NAME
1439

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

            
1442
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1443

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

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

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

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

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

            
1511
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1512

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1523
=item *
1524

            
1525
Filter when data is send or receive.
1526

            
1527
=item *
1528

            
1529
Data filtering system
1530

            
1531
=item *
1532

            
1533
Model support.
1534

            
1535
=item *
1536

            
1537
Generate where clause dinamically.
1538

            
1539
=item *
1540

            
1541
Generate join clause dinamically.
1542

            
1543
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1544

            
1545
=head1 GUIDE
1546

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

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

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

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

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

            
1557
    my $connector = $dbi->connector;
1558
    $dbi          = $dbi->connector(DBIx::Connector->new(...));
1559

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

            
1563
This is L<DBIx::Connector> example. Please pass
1564
C<default_dbi_option> to L<DBIx::Connector>.
1565

            
1566
    my $connector = DBIx::Connector->new(
1567
        "dbi:mysql:database=$DATABASE",
1568
        $USER,
1569
        $PASSWORD,
1570
        DBIx::Custom->new->default_dbi_option
1571
    );
1572
    
1573
    my $dbi = DBIx::Custom->new(connector => $connector);
1574

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

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

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

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

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

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

            
1590
=head2 C<default_dbi_option>
1591

            
1592
    my $default_dbi_option = $dbi->default_dbi_option;
1593
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1594

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

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

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

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

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

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

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

            
1616
    my $models = $dbi->models;
1617
    $dbi       = $dbi->models(\%models);
1618

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1621
=head2 C<password>
1622

            
1623
    my $password = $dbi->password;
1624
    $dbi         = $dbi->password('lkj&le`@s');
1625

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

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

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

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

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

            
1637
     my reserved_word_quote = $dbi->reserved_word_quote;
1638
     $dbi                   = $dbi->reserved_word_quote('"');
1639

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

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

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

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

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

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

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

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1659
    my $user = $dbi->user;
1660
    $dbi     = $dbi->user('Ken');
cleanup
yuki-kimoto authored on 2010-08-05
1661

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

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

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

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

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

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

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

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

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

            
1701
You can set multiple filters at once.
1702

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

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

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

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

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

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

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

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

            
1747
   $dbi->model('book')->select(...);
1748

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

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

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

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

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

            
1765
    my $dbh = $dbi->dbh;
1766

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

            
1770
=head2 C<each_column>
1771

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

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

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

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

            
1796
Execute SQL, containing tags.
1797
Return value is L<DBIx::Custom::Result> in select statement, or
1798
the count of affected rows in insert, update, delete statement.
1799

            
1800
Tag is turned into the statement containing place holder
1801
before SQL is executed.
1802

            
1803
    select * from where title = ? and author like ?;
1804

            
1805
See also L<Tags/Tags>.
1806

            
1807
The following opitons are currently available.
1808

            
1809
=over 4
1810

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

            
1813
Table names for filtering.
1814

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

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

            
1820

            
1821

            
1822

            
1823

            
1824

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

            
1827
Filter, executed before data is send to database. This is array reference.
1828
Filter value is code reference or
1829
filter name registerd by C<register_filter()>.
1830

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

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

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

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

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

            
1865
Delete statement.
1866

            
1867
The following opitons are currently available.
1868

            
update pod
Yuki Kimoto authored on 2011-03-13
1869
=over 4
1870

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

            
1873
Table name.
1874

            
1875
    $dbi->delete(table => 'book');
1876

            
1877
=item C<where>
1878

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

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

            
1902
Append statement to last of SQL. This is string.
1903

            
1904
    $dbi->delete(append => 'order by title');
1905

            
1906
=item C<filter>
1907

            
1908
Filter, executed before data is send to database. This is array reference.
1909
Filter value is code reference or
1910
filter name registerd by C<register_filter()>.
1911

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

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

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

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

            
1941
Create column clause. The follwoing column clause is created.
1942

            
1943
    book.author as book__author,
1944
    book.title as book__title
1945

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

            
1948
Get L<DBIx::Custom::Query> object instead of executing SQL.
1949
This is true or false value.
1950

            
1951
    my $query = $dbi->delete(query => 1);
1952

            
1953
You can check SQL.
1954

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

            
update pod
Yuki Kimoto authored on 2011-03-13
1957
=back
1958

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

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

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

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

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

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

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

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

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

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

            
1989
    # Array reference
1990
    $dbi->delete(primary_key => ['id1', 'id2' ]);
1991

            
1992
This is used to create where clause.
1993

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

            
1996
Where clause, created from primary key information.
1997
This is constant value or array reference.
1998

            
1999
    # Constant value
2000
    $dbi->delete(where => 5);
2001

            
2002
    # Array reference
2003
    $dbi->delete(where => [3, 5]);
2004

            
2005
In first examle, the following SQL is created.
2006

            
2007
    delete from book where id = ?;
2008

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

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

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

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

            
2020
Insert statement.
2021

            
2022
The following opitons are currently available.
2023

            
update pod
Yuki Kimoto authored on 2011-03-13
2024
=over 4
2025

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

            
2028
Table name.
2029

            
2030
    $dbi->insert(table => 'book');
2031

            
2032
=item C<param>
2033

            
2034
Insert data. This is hash reference.
2035

            
2036
    $dbi->insert(param => {title => 'Perl'});
2037

            
2038
=item C<append>
2039

            
2040
Append statement to last of SQL. This is string.
2041

            
2042
    $dbi->insert(append => 'order by title');
2043

            
2044
=item C<filter>
2045

            
2046
Filter, executed before data is send to database. This is array reference.
2047
Filter value is code reference or
2048
filter name registerd by C<register_filter()>.
2049

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

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

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

            
2077
Get L<DBIx::Custom::Query> object instead of executing SQL.
2078
This is true or false value.
2079

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2086
=back
2087

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2103
=over 4
2104

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

            
2107
Primary key. This is constant value or array reference.
2108
    
2109
    # Constant value
2110
    $dbi->insert(primary_key => 'id');
2111

            
2112
    # Array reference
2113
    $dbi->insert(primary_key => ['id1', 'id2' ]);
2114

            
2115
This is used to create parts of insert data.
2116

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

            
2119
Parts of Insert data, create from primary key information.
2120
This is constant value or array reference.
2121

            
2122
    # Constant value
2123
    $dbi->insert(where => 5);
2124

            
2125
    # Array reference
2126
    $dbi->insert(where => [3, 5]);
2127

            
2128
In first examle, the following SQL is created.
2129

            
2130
    insert into book (id, title) values (?, ?);
2131

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2134
=back
2135

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

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

            
2140
Create insert parameter tag.
2141

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

            
- removed DEPRECATED DBIx::C...
Yuki Kimoto authored on 2011-04-11
2144
=head2 C<include_model>
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2145

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2151
    lib / MyModel.pm
2152
        / MyModel / book.pm
2153
                  / company.pm
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2154

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

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

            
2159
    package MyModel;
2160
    
2161
    use base 'DBIx::Custom::Model';
update pod
Yuki Kimoto authored on 2011-03-13
2162
    
2163
    1;
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
2164

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2169
    package MyModel::book;
2170
    
2171
    use base 'MyModel';
2172
    
2173
    1;
removed experimental base_ta...
Yuki Kimoto authored on 2011-02-15
2174

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

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

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

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

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

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

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

            
2196
Merge paramters.
2197

            
2198
$param:
2199

            
2200
    {key1 => [1, 1], key2 => 2}
2201

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

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

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

            
2219
    $dbi->update_or_insert;
2220
    $dbi->find_or_create;
2221

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

            
2224
    $dbi->model('book')->method(
2225
        insert => sub { ... },
2226
        update => sub { ... }
2227
    );
2228
    
2229
    my $model = $dbi->model('book');
2230

            
2231
Set and get a L<DBIx::Custom::Model> object,
2232

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

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

            
2237
Create column clause for myself. The follwoing column clause is created.
2238

            
2239
    book.author as author,
2240
    book.title as title
2241

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

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

            
2251
Create a new L<DBIx::Custom> object.
2252

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

            
2255
    my $not_exists = $dbi->not_exists;
2256

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2260
=head2 C<register_filter>
2261

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2323
The following opitons are currently available.
2324

            
2325
=over 4
2326

            
2327
=item C<table>
2328

            
2329
Table name.
2330

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

            
2333
=item C<column>
2334

            
2335
Column clause. This is array reference or constant value.
2336

            
2337
    # Hash refernce
2338
    $dbi->select(column => ['author', 'title']);
2339
    
2340
    # Constant value
2341
    $dbi->select(column => 'author');
2342

            
2343
Default is '*' unless C<column> is specified.
2344

            
2345
    # Default
2346
    $dbi->select(column => '*');
2347

            
2348
=item C<where>
2349

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

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

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

            
2375
    $dbi->select(join =>
2376
        [
2377
            'left outer join company on book.company_id = company_id',
2378
            'left outer join location on company.location_id = location.id'
2379
        ]
2380
    );
2381

            
2382
If column cluase or where clause contain table name like "company.name",
2383
needed join clause is used automatically.
2384

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

            
2395
In above select, the following SQL is created.
2396

            
2397
    select company.location_id as company__location_id
2398
    from book
2399
      left outer join company on book.company_id = company.id
2400
    where company.name = Orange
2401

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

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

            
2415
For example, if you want to contain tag in join clause, 
2416
you can pass parameter by C<param> option.
2417

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

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

            
2422
    $dbi->select(append => 'order by title');
2423

            
2424
=item C<filter>
2425

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

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

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

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

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

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

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

            
2464
    my $sql = $query->sql;
2465

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

            
2468
Specify database data type.
2469

            
2470
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2471
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2472

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

            
2475
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2476

            
update pod
Yuki Kimoto authored on 2011-03-12
2477
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2478

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

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

            
2483
    $dbi->select_at(
2484
        table => 'book',
2485
        primary_key => 'id',
2486
        where => '5'
2487
    );
2488

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2493
=over 4
2494

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

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

            
2502
    # Array reference
2503
    $dbi->select(primary_key => ['id1', 'id2' ]);
2504

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

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

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

            
2512
    # Constant value
2513
    $dbi->select(where => 5);
2514

            
2515
    # Array reference
2516
    $dbi->select(where => [3, 5]);
2517

            
2518
In first examle, the following SQL is created.
2519

            
2520
    select * from book where id = ?
2521

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2524
=back
2525

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2538
=over 4
2539

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2542
Table name.
2543

            
2544
    $dbi->update(table => 'book');
2545

            
2546
=item C<param>
2547

            
2548
Update data. This is hash reference.
2549

            
2550
    $dbi->update(param => {title => 'Perl'});
2551

            
2552
=item C<where>
2553

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

            
2575
=item C<append>
2576

            
2577
Append statement to last of SQL. This is string.
2578

            
2579
    $dbi->update(append => 'order by title');
2580

            
2581
=item C<filter>
2582

            
2583
Filter, executed before data is send to database. This is array reference.
2584
Filter value is code reference or
2585
filter name registerd by C<register_filter()>.
2586

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

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

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

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

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

            
2619
You can check SQL.
2620

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2623
=back
2624

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2647
=over 4
2648

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

            
2651
Primary key. This is constant value or array reference.
2652
    
2653
    # Constant value
2654
    $dbi->update(primary_key => 'id');
2655

            
2656
    # Array reference
2657
    $dbi->update(primary_key => ['id1', 'id2' ]);
2658

            
2659
This is used to create where clause.
2660

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

            
2663
Where clause, created from primary key information.
2664
This is constant value or array reference.
2665

            
2666
    # Constant value
2667
    $dbi->update(where => 5);
2668

            
2669
    # Array reference
2670
    $dbi->update(where => [3, 5]);
2671

            
2672
In first examle, the following SQL is created.
2673

            
2674
    update book set title = ? where id = ?
2675

            
2676
Place holders are set to 'Perl' and 5.
2677

            
update pod
Yuki Kimoto authored on 2011-03-13
2678
=back
2679

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

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

            
2684
Create update parameter tag.
2685

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

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

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

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

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

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

            
2705
Create a new L<DBIx::Custom::Where> object.
2706

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2714
=head1 Tags
2715

            
2716
The following tags is available.
2717

            
2718
=head2 C<?>
2719

            
2720
Placeholder tag.
2721

            
2722
    {? NAME}    ->   ?
2723

            
2724
=head2 C<=>
2725

            
2726
Equal tag.
2727

            
2728
    {= NAME}    ->   NAME = ?
2729

            
2730
=head2 C<E<lt>E<gt>>
2731

            
2732
Not equal tag.
2733

            
2734
    {<> NAME}   ->   NAME <> ?
2735

            
2736
=head2 C<E<lt>>
2737

            
2738
Lower than tag
2739

            
2740
    {< NAME}    ->   NAME < ?
2741

            
2742
=head2 C<E<gt>>
2743

            
2744
Greater than tag
2745

            
2746
    {> NAME}    ->   NAME > ?
2747

            
2748
=head2 C<E<gt>=>
2749

            
2750
Greater than or equal tag
2751

            
2752
    {>= NAME}   ->   NAME >= ?
2753

            
2754
=head2 C<E<lt>=>
2755

            
2756
Lower than or equal tag
2757

            
2758
    {<= NAME}   ->   NAME <= ?
2759

            
2760
=head2 C<like>
2761

            
2762
Like tag
2763

            
2764
    {like NAME}   ->   NAME like ?
2765

            
2766
=head2 C<in>
2767

            
2768
In tag.
2769

            
2770
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2771

            
2772
=head2 C<insert_param>
2773

            
2774
Insert parameter tag.
2775

            
2776
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2777

            
2778
=head2 C<update_param>
2779

            
2780
Updata parameter tag.
2781

            
2782
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2783

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

            
2786
=head2 C<DBIX_CUSTOM_DEBUG>
2787

            
2788
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2789
executed SQL is printed to STDERR.
2790

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

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

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

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

            
2800
C<< <kimoto.yuki at gmail.com> >>
2801

            
2802
L<http://github.com/yuki-kimoto/DBIx-Custom>
2803

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2804
=head1 AUTHOR
2805

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

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

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

            
2812
This program is free software; you can redistribute it and/or modify it
2813
under the same terms as Perl itself.
2814

            
2815
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2816

            
2817