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

            
cleanup
Yuki Kimoto authored on 2011-04-25
3
our $VERSION = '0.1680';
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;
cleanup
Yuki Kimoto authored on 2011-04-25
19
use DBIx::Custom::Util qw/_array_to_hash _subname/;
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 {
cleanup
Yuki Kimoto authored on 2011-04-25
81
        croak qq{Can't locate object method "$mname" via "$package" }
82
            . _subname;
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] || {};
cleanup
Yuki Kimoto authored on 2011-04-25
114
        croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
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) {
cleanup
Yuki Kimoto authored on 2011-04-25
117
            croak "$usage (table: $table) " . _subname
improved error messages
Yuki Kimoto authored on 2011-04-18
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
cleanup
Yuki Kimoto authored on 2011-04-25
137
            croak qq{Filter "$filter" is not registered } . _subname
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
138
              if  $state eq 'name'
139
               && ! exists $self->filters->{$filter};
140
            
cleanup
Yuki Kimoto authored on 2011-04-02
141
            # Set filter
fix bug : filter can't over...
Yuki Kimoto authored on 2011-02-09
142
            my $f = $state eq 'not_defined' ? undef
143
                  : $state eq 'code'        ? $filter
144
                  : $self->filters->{$filter};
145
            $self->{filter}{$way}{$table}{$column} = $f;
146
            $self->{filter}{$way}{$table}{"$table.$column"} = $f;
147
            $self->{filter}{$way}{$table}{"${table}__$column"} = $f;
many changed
Yuki Kimoto authored on 2011-01-23
148
        }
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
149
    }
150
    
many changed
Yuki Kimoto authored on 2011-01-23
151
    return $self;
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
152
}
153

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
added helper method
yuki-kimoto authored on 2010-10-17
340
sub DESTROY { }
341

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

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

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

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

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

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

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

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

            
552
    # Check arguments
553
    foreach my $name (keys %args) {
cleanup
Yuki Kimoto authored on 2011-04-25
554
        croak qq{"$name" is wrong option } . _subname
cleanup
Yuki Kimoto authored on 2011-04-02
555
          unless $INSERT_ARGS{$name};
556
    }
557

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

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

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
722
sub method {
723
    my $self = shift;
724
    
cleanup
Yuki Kimoto authored on 2011-04-02
725
    # Register method
cleanup
Yuki Kimoto authored on 2011-03-21
726
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
727
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
728
    
729
    return $self;
730
}
731

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

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

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

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-21
803
our %SELECT_ARGS
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
804
  = map { $_ => 1 } @COMMON_ARGS,
805
                    qw/column where append relation join param wrap/;
refactoring select
yuki-kimoto authored on 2010-04-28
806

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-04-02
868
    # Add tables in parameter
869
    unshift @$tables, @{$self->_search_tables(join(' ', keys %$param) || '')};
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
870
    
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
871
    # Where
cleanup
Yuki Kimoto authored on 2011-04-25
872
    my $where_clause;
873
    if (ref $where) {
874
        $where = $self->_where_to_obj($where);
875
        $param = keys %$param ? $self->merge_param($param, $where->param)
876
                              : $where->param;
877
        
878
        # String where
879
        $where_clause = $where->to_string;
880
    }
881
    else {
882
        $where_clause = $where;
883
    }
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
884
    
fixed some select() join opi...
Yuki Kimoto authored on 2011-03-09
885
    # Add table names in where clause
cleanup
Yuki Kimoto authored on 2011-04-02
886
    unshift @$tables, @{$self->_search_tables($where_clause)};
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
    # Push join
889
    $self->_push_join(\@sql, $join, $tables);
remove experimental DBIx::Cu...
Yuki Kimoto authored on 2011-03-08
890
    
cleanup
Yuki Kimoto authored on 2011-03-09
891
    # Add where clause
cleanup
Yuki Kimoto authored on 2011-04-02
892
    push @sql, $where_clause;
select() where can't receive...
Yuki Kimoto authored on 2011-01-27
893
    
cleanup
Yuki Kimoto authored on 2011-03-08
894
    # Relation(DEPRECATED!);
cleanup
Yuki Kimoto authored on 2011-04-02
895
    $self->_push_relation(\@sql, $tables, $relation, $where_clause eq '' ? 1 : 0);
cleanup
Yuki Kimoto authored on 2011-03-08
896
    
cleanup
Yuki Kimoto authored on 2011-04-02
897
    # Append
cleanup
Yuki Kimoto authored on 2011-01-27
898
    push @sql, $append if $append;
899
    
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
900
    # Wrap
901
    if ($wrap) {
cleanup
Yuki Kimoto authored on 2011-04-25
902
        croak "wrap option must be array refrence " . _subname
added EXPERIMENTAL select() ...
Yuki Kimoto authored on 2011-04-19
903
          unless ref $wrap eq 'ARRAY';
904
        unshift @sql, $wrap->[0];
905
        push @sql, $wrap->[1];
906
    }
907
    
cleanup
Yuki Kimoto authored on 2011-01-27
908
    # SQL
909
    my $sql = join (' ', @sql);
packaging one directory
yuki-kimoto authored on 2009-11-16
910
    
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
911
    # Create query
cleanup
Yuki Kimoto authored on 2011-01-27
912
    my $query = $self->create_query($sql);
cleanup
Yuki Kimoto authored on 2011-04-02
913
    return $query if $query_return;
added experimental sugar met...
Yuki Kimoto authored on 2011-01-17
914
    
packaging one directory
yuki-kimoto authored on 2009-11-16
915
    # Execute query
added auto_filter method
kimoto.yuki@gmail.com authored on 2010-12-21
916
    my $result = $self->execute(
cleanup
Yuki Kimoto authored on 2011-03-21
917
        $query,
cleanup
Yuki Kimoto authored on 2011-04-02
918
        param => $param, 
cleanup
Yuki Kimoto authored on 2011-03-21
919
        table => $tables,
920
        %args
921
    );
packaging one directory
yuki-kimoto authored on 2009-11-16
922
    
923
    return $result;
924
}
925

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
1440
=head1 NAME
1441

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

            
1444
=head1 SYNOPSYS
cleanup
yuki-kimoto authored on 2010-08-05
1445

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

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

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

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

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

            
1513
=head1 FEATURES
removed reconnect method
yuki-kimoto authored on 2010-05-28
1514

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

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

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

            
- remaned experimental safty...
Yuki Kimoto authored on 2011-03-10
1525
=item *
1526

            
1527
Filter when data is send or receive.
1528

            
1529
=item *
1530

            
1531
Data filtering system
1532

            
1533
=item *
1534

            
1535
Model support.
1536

            
1537
=item *
1538

            
1539
Generate where clause dinamically.
1540

            
1541
=item *
1542

            
1543
Generate join clause dinamically.
1544

            
1545
=back
pod fix
Yuki Kimoto authored on 2011-01-21
1546

            
1547
=head1 GUIDE
1548

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1592
=head2 C<default_dbi_option>
1593

            
1594
    my $default_dbi_option = $dbi->default_dbi_option;
1595
    $dbi            = $dbi->default_dbi_option($default_dbi_option);
1596

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

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

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

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

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

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

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

            
1618
    my $models = $dbi->models;
1619
    $dbi       = $dbi->models(\%models);
1620

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

            
cleanup
yuki-kimoto authored on 2010-10-17
1623
=head2 C<password>
1624

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

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

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

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

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

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

            
1639
     my reserved_word_quote = $dbi->reserved_word_quote;
1640
     $dbi                   = $dbi->reserved_word_quote('"');
1641

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1703
You can set multiple filters at once.
1704

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

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

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

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

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

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

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

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

            
1749
   $dbi->model('book')->select(...);
1750

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

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

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

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

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

            
1767
    my $dbh = $dbi->dbh;
1768

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

            
1772
=head2 C<each_column>
1773

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

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

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

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

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

            
1802
Tag is turned into the statement containing place holder
1803
before SQL is executed.
1804

            
1805
    select * from where title = ? and author like ?;
1806

            
1807
See also L<Tags/Tags>.
1808

            
1809
The following opitons are currently available.
1810

            
1811
=over 4
1812

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

            
1815
Table names for filtering.
1816

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

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

            
1822

            
1823

            
1824

            
1825

            
1826

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

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

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

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

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

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

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

            
1867
Delete statement.
1868

            
1869
The following opitons are currently available.
1870

            
update pod
Yuki Kimoto authored on 2011-03-13
1871
=over 4
1872

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

            
1875
Table name.
1876

            
1877
    $dbi->delete(table => 'book');
1878

            
1879
=item C<where>
1880

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

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

            
1904
Append statement to last of SQL. This is string.
1905

            
1906
    $dbi->delete(append => 'order by title');
1907

            
1908
=item C<filter>
1909

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

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

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

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

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

            
1943
Create column clause. The follwoing column clause is created.
1944

            
1945
    book.author as book__author,
1946
    book.title as book__title
1947

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

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

            
1953
    my $query = $dbi->delete(query => 1);
1954

            
1955
You can check SQL.
1956

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

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

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

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

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

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

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

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

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

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

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

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

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

            
1994
This is used to create where clause.
1995

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

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

            
2001
    # Constant value
2002
    $dbi->delete(where => 5);
2003

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

            
2007
In first examle, the following SQL is created.
2008

            
2009
    delete from book where id = ?;
2010

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

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

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

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

            
2022
Insert statement.
2023

            
2024
The following opitons are currently available.
2025

            
update pod
Yuki Kimoto authored on 2011-03-13
2026
=over 4
2027

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

            
2030
Table name.
2031

            
2032
    $dbi->insert(table => 'book');
2033

            
2034
=item C<param>
2035

            
2036
Insert data. This is hash reference.
2037

            
2038
    $dbi->insert(param => {title => 'Perl'});
2039

            
2040
=item C<append>
2041

            
2042
Append statement to last of SQL. This is string.
2043

            
2044
    $dbi->insert(append => 'order by title');
2045

            
2046
=item C<filter>
2047

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

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

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

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

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

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

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

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

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

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

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2105
=over 4
2106

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

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

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

            
2117
This is used to create parts of insert data.
2118

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

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

            
2124
    # Constant value
2125
    $dbi->insert(where => 5);
2126

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

            
2130
In first examle, the following SQL is created.
2131

            
2132
    insert into book (id, title) values (?, ?);
2133

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

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

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

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

            
2142
Create insert parameter tag.
2143

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2198
Merge paramters.
2199

            
2200
$param:
2201

            
2202
    {key1 => [1, 1], key2 => 2}
2203

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

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

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

            
2221
    $dbi->update_or_insert;
2222
    $dbi->find_or_create;
2223

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

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

            
2233
Set and get a L<DBIx::Custom::Model> object,
2234

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

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

            
2239
Create column clause for myself. The follwoing column clause is created.
2240

            
2241
    book.author as author,
2242
    book.title as title
2243

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

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

            
2253
Create a new L<DBIx::Custom> object.
2254

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

            
2257
    my $not_exists = $dbi->not_exists;
2258

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

            
cleanup
yuki-kimoto authored on 2010-10-17
2262
=head2 C<register_filter>
2263

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

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

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

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

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

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

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

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

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

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

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

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

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

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

            
2325
The following opitons are currently available.
2326

            
2327
=over 4
2328

            
2329
=item C<table>
2330

            
2331
Table name.
2332

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

            
2335
=item C<column>
2336

            
2337
Column clause. This is array reference or constant value.
2338

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

            
2345
Default is '*' unless C<column> is specified.
2346

            
2347
    # Default
2348
    $dbi->select(column => '*');
2349

            
2350
=item C<where>
2351

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

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

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

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

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

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

            
2397
In above select, the following SQL is created.
2398

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

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

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

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

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

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

            
2424
    $dbi->select(append => 'order by title');
2425

            
improved pod
Yuki Kimoto authored on 2011-04-19
2426
=item C<wrap> EXPERIMENTAL
2427

            
2428
Wrap statement. This is array reference.
2429

            
2430
    $dbi->select(wrap => ['select * from (', ') as t where ROWNUM < 10']);
2431

            
2432
This option is for Oracle and SQL Server paging process.
2433

            
update pod
Yuki Kimoto authored on 2011-03-12
2434
=item C<filter>
2435

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

            
2440
    # Basic
2441
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2442
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2443
            title  => sub { uc $_[0] }
2444
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2445
        }
update pod
Yuki Kimoto authored on 2011-03-12
2446
    );
2447
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2448
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-12
2449
    $dbi->select(
2450
        filter => [
2451
            [qw/title author/]  => sub { uc $_[0] }
2452
        ]
2453
    );
2454
    
2455
    # Filter name
2456
    $dbi->select(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2457
        filter => {
update pod
Yuki Kimoto authored on 2011-03-12
2458
            title  => 'upper_case',
2459
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2460
        }
update pod
Yuki Kimoto authored on 2011-03-12
2461
    );
add experimental selection o...
Yuki Kimoto authored on 2011-02-09
2462

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

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

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

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

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

            
2474
    my $sql = $query->sql;
2475

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

            
2478
Specify database data type.
2479

            
2480
    $dbi->select(type => [image => DBI::SQL_BLOB]);
2481
    $dbi->select(type => [[qw/image audio/] => DBI::SQL_BLOB]);
2482

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

            
2485
    $sth->bind_param($pos, $value, DBI::SQL_BLOB);
2486

            
update pod
Yuki Kimoto authored on 2011-03-12
2487
=back
cleanup
Yuki Kimoto authored on 2011-03-08
2488

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

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

            
2493
    $dbi->select_at(
2494
        table => 'book',
2495
        primary_key => 'id',
2496
        where => '5'
2497
    );
2498

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2503
=over 4
2504

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

            
update pod
Yuki Kimoto authored on 2011-03-12
2507
Primary key. This is constant value or array reference.
2508
    
2509
    # Constant value
2510
    $dbi->select(primary_key => 'id');
2511

            
2512
    # Array reference
2513
    $dbi->select(primary_key => ['id1', 'id2' ]);
2514

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

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

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

            
2522
    # Constant value
2523
    $dbi->select(where => 5);
2524

            
2525
    # Array reference
2526
    $dbi->select(where => [3, 5]);
2527

            
2528
In first examle, the following SQL is created.
2529

            
2530
    select * from book where id = ?
2531

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

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2538
    $dbi->update(
2539
        table  => 'book',
2540
        param  => {title => 'Perl'},
2541
        where  => {id => 4}
2542
    );
removed reconnect method
yuki-kimoto authored on 2010-05-28
2543

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

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2548
=over 4
2549

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2552
Table name.
2553

            
2554
    $dbi->update(table => 'book');
2555

            
2556
=item C<param>
2557

            
2558
Update data. This is hash reference.
2559

            
2560
    $dbi->update(param => {title => 'Perl'});
2561

            
2562
=item C<where>
2563

            
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2564
Where clause. This is hash reference or L<DBIx::Custom::Where> object
2565
or array refrence.
update pod
Yuki Kimoto authored on 2011-03-13
2566
    
2567
    # Hash reference
2568
    $dbi->update(where => {author => 'Ken', 'title' => 'Perl'});
2569
    
2570
    # DBIx::Custom::Where object
2571
    my $where = $dbi->where(
2572
        clause => ['and', '{= author}', '{like title}'],
2573
        param  => {author => 'Ken', title => '%Perl%'}
2574
    );
2575
    $dbi->update(where => $where);
where can recieve array refr...
Yuki Kimoto authored on 2011-03-24
2576
    
2577
    # Array refrendce (where clause and parameter)
2578
    $dbi->update(where =>
2579
        [
2580
            ['and', '{= author}', '{like title}'],
2581
            {author => 'Ken', title => '%Perl%'}
2582
        ]
2583
    );
update pod
Yuki Kimoto authored on 2011-03-13
2584

            
2585
=item C<append>
2586

            
2587
Append statement to last of SQL. This is string.
2588

            
2589
    $dbi->update(append => 'order by title');
2590

            
2591
=item C<filter>
2592

            
2593
Filter, executed before data is send to database. This is array reference.
2594
Filter value is code reference or
2595
filter name registerd by C<register_filter()>.
2596

            
2597
    # Basic
2598
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2599
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2600
            title  => sub { uc $_[0] }
2601
            author => sub { uc $_[0] }
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2602
        }
update pod
Yuki Kimoto authored on 2011-03-13
2603
    );
2604
    
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2605
    # At once (use array reference)
update pod
Yuki Kimoto authored on 2011-03-13
2606
    $dbi->update(
2607
        filter => [
2608
            [qw/title author/]  => sub { uc $_[0] }
2609
        ]
2610
    );
2611
    
2612
    # Filter name
2613
    $dbi->update(
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2614
        filter => {
update pod
Yuki Kimoto authored on 2011-03-13
2615
            title  => 'upper_case',
2616
            author => 'upper_case'
DBIx::Custom::Model filter a...
Yuki Kimoto authored on 2011-04-18
2617
        }
update pod
Yuki Kimoto authored on 2011-03-13
2618
    );
added experimental update_pa...
Yuki Kimoto authored on 2011-03-08
2619

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

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

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

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

            
2629
You can check SQL.
2630

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

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

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

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

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

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

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

            
2646
    $dbi->update_at(
2647
        table => 'book',
update pod
Yuki Kimoto authored on 2011-03-13
2648
        primary_key => 'id',
2649
        where => '5',
2650
        param => {title => 'Perl'}
add experimental update_at()...
Yuki Kimoto authored on 2011-02-21
2651
    );
2652

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

            
update pod
Yuki Kimoto authored on 2011-03-13
2657
=over 4
2658

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

            
2661
Primary key. This is constant value or array reference.
2662
    
2663
    # Constant value
2664
    $dbi->update(primary_key => 'id');
2665

            
2666
    # Array reference
2667
    $dbi->update(primary_key => ['id1', 'id2' ]);
2668

            
2669
This is used to create where clause.
2670

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

            
2673
Where clause, created from primary key information.
2674
This is constant value or array reference.
2675

            
2676
    # Constant value
2677
    $dbi->update(where => 5);
2678

            
2679
    # Array reference
2680
    $dbi->update(where => [3, 5]);
2681

            
2682
In first examle, the following SQL is created.
2683

            
2684
    update book set title = ? where id = ?
2685

            
2686
Place holders are set to 'Perl' and 5.
2687

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

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

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

            
2694
Create update parameter tag.
2695

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

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

            
- renamed update_param to up...
Yuki Kimoto authored on 2011-03-30
2701
    my $update_param_tag = $dbi->update_param_tag(
added EXPERIMENTAL updat_par...
Yuki Kimoto authored on 2011-03-30
2702
        {title => 'a', age => 2}
2703
        {no_set => 1}
2704
    );
2705

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

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

            
cleanup
Yuki Kimoto authored on 2011-03-09
2710
    my $where = $dbi->where(
2711
        clause => ['and', '{= title}', '{= author}'],
2712
        param => {title => 'Perl', author => 'Ken'}
2713
    );
fix tests
Yuki Kimoto authored on 2011-01-18
2714

            
2715
Create a new L<DBIx::Custom::Where> object.
2716

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

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

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

            
cleanup
Yuki Kimoto authored on 2011-01-25
2724
=head1 Tags
2725

            
2726
The following tags is available.
2727

            
2728
=head2 C<?>
2729

            
2730
Placeholder tag.
2731

            
2732
    {? NAME}    ->   ?
2733

            
2734
=head2 C<=>
2735

            
2736
Equal tag.
2737

            
2738
    {= NAME}    ->   NAME = ?
2739

            
2740
=head2 C<E<lt>E<gt>>
2741

            
2742
Not equal tag.
2743

            
2744
    {<> NAME}   ->   NAME <> ?
2745

            
2746
=head2 C<E<lt>>
2747

            
2748
Lower than tag
2749

            
2750
    {< NAME}    ->   NAME < ?
2751

            
2752
=head2 C<E<gt>>
2753

            
2754
Greater than tag
2755

            
2756
    {> NAME}    ->   NAME > ?
2757

            
2758
=head2 C<E<gt>=>
2759

            
2760
Greater than or equal tag
2761

            
2762
    {>= NAME}   ->   NAME >= ?
2763

            
2764
=head2 C<E<lt>=>
2765

            
2766
Lower than or equal tag
2767

            
2768
    {<= NAME}   ->   NAME <= ?
2769

            
2770
=head2 C<like>
2771

            
2772
Like tag
2773

            
2774
    {like NAME}   ->   NAME like ?
2775

            
2776
=head2 C<in>
2777

            
2778
In tag.
2779

            
2780
    {in NAME COUNT}   ->   NAME in [?, ?, ..]
2781

            
2782
=head2 C<insert_param>
2783

            
2784
Insert parameter tag.
2785

            
2786
    {insert_param NAME1 NAME2}   ->   (NAME1, NAME2) values (?, ?)
2787

            
2788
=head2 C<update_param>
2789

            
2790
Updata parameter tag.
2791

            
2792
    {update_param NAME1 NAME2}   ->   set NAME1 = ?, NAME2 = ?
2793

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

            
2796
=head2 C<DBIX_CUSTOM_DEBUG>
2797

            
2798
If environment variable C<DBIX_CUSTOM_DEBUG> is set to true,
2799
executed SQL is printed to STDERR.
2800

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

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

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

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

            
2810
C<< <kimoto.yuki at gmail.com> >>
2811

            
2812
L<http://github.com/yuki-kimoto/DBIx-Custom>
2813

            
removed reconnect method
yuki-kimoto authored on 2010-05-28
2814
=head1 AUTHOR
2815

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

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

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

            
2822
This program is free software; you can redistribute it and/or modify it
2823
under the same terms as Perl itself.
2824

            
2825
=cut
added cache_method attribute
yuki-kimoto authored on 2010-06-25
2826

            
2827