Newer Older
348 lines | 7.286kb
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
1
package DBIx::Custom::Model;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
2

            
3
use strict;
4
use warnings;
5

            
6
use base 'Object::Simple';
7

            
8
use Carp 'croak';
9

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-18
10
# Carp trust relationship
11
push @DBIx::Custom::CARP_NOT, __PACKAGE__;
12

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
13
__PACKAGE__->attr(
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
14
    ['dbi', 'name', 'table', 'column'],
add DBIx::Custom::Model colu...
Yuki Kimoto authored on 2011-02-21
15
    columns => sub { [] },
all filter can receive array...
Yuki Kimoto authored on 2011-02-25
16
    filter => sub { [] },
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
17
    primary_key => sub { [] },
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
18
    join => sub { [] }
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
19
);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
20

            
21
our $AUTOLOAD;
22

            
23
sub AUTOLOAD {
24
    my $self = shift;
25

            
renamed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-25
26
    # Method name
27
    my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/;
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
28

            
renamed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-25
29
    # Method
30
    $self->{_methods} ||= {};
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
31
    if (my $method = $self->{_methods}->{$mname}) {
32
        return $self->$method(@_)
33
    }
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
34
    elsif ($self->dbi->can($mname)) {
35
        $self->dbi->$mname(@_);
36
    }
37
    elsif ($self->dbi->dbh->can($mname)) {
38
        $self->dbi->dbh->$mname(@_);
39
    }
40
    else {
41
        croak qq/Can't locate object method "$mname" via "$package"/
42
    }
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
43
}
44

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
45
sub column_clause {
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
46
    my $self = shift;
47
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
48
    my $args = ref $_[0] eq 'HASH' ? $_[0] : {@_};
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
49
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
50
    my $table   = $self->table;
51
    my $columns = $self->columns;
52
    my $add     = $args->{add} || [];
53
    my $remove  = $args->{remove} || [];
54
    my %remove  = map {$_ => 1} @$remove;
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
55
    my $prefix  = $args->{prefix} || '';
select method column option ...
Yuki Kimoto authored on 2011-02-22
56
    
57
    my @column;
58
    foreach my $column (@$columns) {
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
59
        push @column, "$table.$column as $prefix$column"
select method column option ...
Yuki Kimoto authored on 2011-02-22
60
          unless $remove{$column};
61
    }
62
    
63
    foreach my $column (@$add) {
64
        push @column, $column;
65
    }
66
    
67
    return join (', ', @column);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
68
}
69

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
70
sub delete {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
71
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
72
    $self->dbi->delete(table => $self->table, @_);
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
73
}
74

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
75
sub delete_all {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
76
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
77
    $self->dbi->delete_all(table => $self->table, @_);
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
78
}
79

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
80
sub delete_at {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
81
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
82
    
83
    return $self->dbi->delete_at(
84
        table => $self->table,
85
        primary_key => $self->primary_key,
86
        @_
87
    );
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
88
}
89

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
90
sub DESTROY { }
91

            
92
sub insert {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
93
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
94
    $self->dbi->insert(table => $self->table, @_);
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
95
}
96

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-02-28
97
sub insert_at {
98
    my $self = shift;
99
    
100
    return $self->dbi->insert_at(
101
        table => $self->table,
102
        primary_key => $self->primary_key,
103
        @_
104
    );
105
}
106

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
107
sub method {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
108
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
109
    
110
    # Merge
111
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
112
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
113
    
114
    return $self;
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
115
}
116

            
117
sub select {
118
    my $self = shift;
119
    $self->dbi->select(
120
        table => $self->table,
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
121
        column => $self->column,
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
122
        join => $self->join,
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
123
        @_
124
    );
125
}
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
126

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
127
sub select_at {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
128
    my $self = shift;
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
129
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
130
    return $self->dbi->select_at(
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
131
        table => $self->table,
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
132
        column => $self->column,
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
133
        primary_key => $self->primary_key,
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
134
        join => $self->join,
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
135
        @_
136
    );
137
}
138

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
139
sub update {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
140
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
141
    $self->dbi->update(table => $self->table, @_)
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
142
}
143

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
144
sub update_all {
145
    my $self = shift;
146
    $self->dbi->update_all(table => $self->table, @_);
147
}
148

            
149

            
150
sub update_at {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
151
    my $self = shift;
many changed
Yuki Kimoto authored on 2011-01-23
152
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
153
    return $self->dbi->update_at(
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
154
        table => $self->table,
155
        primary_key => $self->primary_key,
156
        @_
157
    );
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
158
}
159

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
160
1;
161

            
162
=head1 NAME
163

            
update pod
Yuki Kimoto authored on 2011-03-13
164
DBIx::Custom::Model - Model EXPERIMENTAL
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
165

            
166
=head1 SYNOPSIS
167

            
168
use DBIx::Custom::Table;
169

            
add feture. all model class ...
Yuki Kimoto authored on 2011-02-18
170
my $table = DBIx::Custom::Model->new(table => 'books');
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
171

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
172
=head1 ATTRIBUTES
173

            
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
174
=head2 C<columns>
add DBIx::Custom::Model colu...
Yuki Kimoto authored on 2011-02-21
175

            
176
    my $columns = $model->columns;
177
    $model      = $model->columns(['id', 'number']);
178

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
179
=head2 C<dbi>
180

            
181
    my $dbi = $model->dbi;
182
    $model  = $model->dbi($dbi);
183

            
184
L<DBIx::Custom> object.
185

            
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
186
=head2 C<filter>
187

            
188
    my $dbi = $model->filter
189
    $model  = $model->filter({out => 'tp_to_date', in => 'date_to_tp'});
190

            
191
This filter is applied when L<DBIx::Custom> C<include_model()> is called.
192

            
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
193
=head2 C<name>
194

            
195
    my $name = $model->name;
196
    $model   = $model->name('book');
197

            
198
Model name.
199

            
update pod
Yuki Kimoto authored on 2011-03-13
200
=head2 C<join>
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-08
201

            
202
    my $join = $model->join;
203
    $model   = $model->join(
204
        ['left outer join company on book.company_id = company.id']
205
    );
206
    
207
Default join clause. This is used by C<select()>.
208

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
209
=head2 C<table>
210

            
211
    my $table = $model->table;
212
    $model    = $model->table('book');
213

            
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-24
214
Table name. Model name and table name is different.
215
Table name is real table name in database.
216

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
217
=head2 C<primary_key>
218

            
219
    my $primary_key = $model->primary_key;
220
    $model          = $model->primary_key(['id', 'number']);
221

            
update pod
Yuki Kimoto authored on 2011-02-28
222
Foreign key. This is used by C<insert_at>,C<update_at()>,
223
C<delete_at()>,C<select_at()>.
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
224

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
225
=head1 METHODS
226

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
227
L<DBIx::Custom> inherits all methods from L<Object::Simple>,
228
and you can use all methods of the object set to C<dbi>.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
229
and implements the following new ones.
230

            
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-22
231
=head2 C<column_clause()>
232

            
233
To create column clause automatically, use C<column_clause()>.
234
Valude of C<table> and C<columns> is used.
235

            
236
    my $column_clause = $model->column_clause;
237

            
238
If C<table> is 'book'�AC<column> is ['id', 'name'],
239
the following clause is created.
240

            
241
    book.id as id, book.name as name
242

            
243
These column name is for removing column name ambiguities.
244

            
245
If you remove some columns, use C<remove> option.
246

            
247
    my $column_clause = $model->column_clause(remove => ['id']);
248

            
249
If you add some column, use C<add> option.
250

            
251
    my $column_clause = $model->column_clause(add => ['company.id as company__id']);
252

            
- added experimental DBIx::C...
Yuki Kimoto authored on 2011-03-11
253
If you add column name prefix, use C<prefix> option
254

            
255
    my $column_clause = $model->column_clause(prefix => 'book__');
256

            
257
The following clause is created.
258

            
259
    book.id as book__id, book.name as book__name
260

            
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
261
=head2 C<delete>
262

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
263
    $table->delete(...);
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
264
    
265
Same as C<delete()> of L<DBIx::Custom> except that
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
266
you don't have to specify C<table> option.
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
267

            
268
=head2 C<delete_all>
269

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
270
    $table->delete_all(...);
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
271
    
272
Same as C<delete_all()> of L<DBIx::Custom> except that
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
273
you don't have to specify C<table> option.
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
274

            
update pod
Yuki Kimoto authored on 2011-02-28
275
=head2 C<delete_at>
276

            
277
    $table->delete_at(...);
278
    
279
Same as C<delete()> of L<DBIx::Custom> except that
280
you don't have to specify C<table> and C<primary_key> option.
281

            
renamed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-25
282
=head2 C<method>
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
283

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
284
    $table->method(
285
        count => sub {
286
            my $self = shift;
simplified DBIx::Custom::Mod...
Yuki Kimoto authored on 2011-01-02
287
        
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
288
            return $self->select(column => 'count(*)', @_)
289
                        ->fetch_first->[0];
290
        }
291
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
292
    
renamed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-25
293
Add method to a L<DBIx::Custom::Table> object.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
294

            
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
295
=head2 C<insert>
296

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
297
    $table->insert(...);
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
298
    
299
Same as C<insert()> of L<DBIx::Custom> except that
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
300
you don't have to specify C<table> option.
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
301

            
update pod
Yuki Kimoto authored on 2011-02-28
302
=head2 C<insert>
303

            
304
    $table->insert_at(...);
305
    
306
Same as C<insert_at()> of L<DBIx::Custom> except that
307
you don't have to specify C<table> and C<primary_key> option.
308

            
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
309
=head2 C<new>
310

            
311
    my $table = DBIx::Custom::Table->new;
312

            
313
Create a L<DBIx::Custom::Table> object.
314

            
315
=head2 C<select>
316

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
317
    $table->select(...);
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
318
    
319
Same as C<select()> of L<DBIx::Custom> except that
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
320
you don't have to specify C<table> option.
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
321

            
update pod
Yuki Kimoto authored on 2011-02-28
322
=head2 C<select_at>
323

            
324
    $table->select_at(...);
325
    
326
Same as C<select_at()> of L<DBIx::Custom> except that
327
you don't have to specify C<table> and C<primary_key> option.
328

            
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
329
=head2 C<update>
330

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
331
    $table->update(...);
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
332
    
333
Same as C<update()> of L<DBIx::Custom> except that
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
334
you don't have to specify C<table> option.
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
335

            
336
=head2 C<update_all>
337

            
338
    $table->update_all(param => \%param);
339
    
340
Same as C<update_all()> of L<DBIx::Custom> except that
341
you don't have to specify table name.
update pod
Yuki Kimoto authored on 2011-02-28
342

            
343
=head2 C<update_at>
344

            
345
    $table->update_at(...);
346
    
347
Same as C<update_at()> of L<DBIx::Custom> except that
348
you don't have to specify C<table> and C<primary_key> option.