Newer Older
274 lines | 5.522kb
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(
14
    ['dbi', 'table'],
add DBIx::Custom::Model colu...
Yuki Kimoto authored on 2011-02-21
15
    columns => sub { [] },
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
16
    primary_key => sub { [] },
17
    relation => sub { {} }
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
18
);
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
19

            
20
our $AUTOLOAD;
21

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

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

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

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

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

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

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

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

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

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
95
sub method {
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
96
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
97
    
98
    # Merge
99
    my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_};
100
    $self->{_methods} = {%{$self->{_methods} || {}}, %$methods};
101
    
102
    return $self;
DBIx::Custom::Model select()...
Yuki Kimoto authored on 2011-02-22
103
}
104

            
105
sub select {
106
    my $self = shift;
107
    $self->dbi->select(
108
        table => $self->table,
109
        relation => $self->relation,
110
        @_
111
    );
112
}
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
113

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
114
sub select_at {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
115
    my $self = shift;
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
116
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
117
    return $self->dbi->select_at(
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
118
        table => $self->table,
119
        primary_key => $self->primary_key,
select method column option ...
Yuki Kimoto authored on 2011-02-22
120
        relation => $self->relation,
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
121
        @_
122
    );
123
}
124

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
125
sub update {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
126
    my $self = shift;
select method column option ...
Yuki Kimoto authored on 2011-02-22
127
    $self->dbi->update(table => $self->table, @_)
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
128
}
129

            
select method column option ...
Yuki Kimoto authored on 2011-02-22
130
sub update_all {
131
    my $self = shift;
132
    $self->dbi->update_all(table => $self->table, @_);
133
}
134

            
135

            
136
sub update_at {
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
137
    my $self = shift;
many changed
Yuki Kimoto authored on 2011-01-23
138
    
select method column option ...
Yuki Kimoto authored on 2011-02-22
139
    return $self->dbi->update_at(
add experimental DBIx::Custo...
Yuki Kimoto authored on 2011-02-21
140
        table => $self->table,
141
        primary_key => $self->primary_key,
142
        @_
143
    );
added insert, update, update...
Yuki Kimoto authored on 2011-01-04
144
}
145

            
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
146
1;
147

            
148
=head1 NAME
149

            
add DBIx::Custom::Model fore...
Yuki Kimoto authored on 2011-02-21
150
DBIx::Custom::Model - Model (experimental)
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
151

            
152
=head1 SYNOPSIS
153

            
154
use DBIx::Custom::Table;
155

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

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

            
add DBIx::Custom::Model colu...
Yuki Kimoto authored on 2011-02-21
160
=head2 C<(experimental) columns>
161

            
162
    my $columns = $model->columns;
163
    $model      = $model->columns(['id', 'number']);
164

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

            
167
    my $dbi = $model->dbi;
168
    $model  = $model->dbi($dbi);
169

            
170
L<DBIx::Custom> object.
171

            
172
=head2 C<table>
173

            
174
    my $table = $model->table;
175
    $model    = $model->table('book');
176

            
177
Table name.
178
    
179
=head2 C<primary_key>
180

            
181
    my $primary_key = $model->primary_key;
182
    $model          = $model->primary_key(['id', 'number']);
183

            
184
Foreign key. This is used by C<update_at()>, C<delete_at()>,
185
C<select_at()>.
186

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

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

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

            
195
To create column clause automatically, use C<column_clause()>.
196
Valude of C<table> and C<columns> is used.
197

            
198
    my $column_clause = $model->column_clause;
199

            
200
If C<table> is 'book'�AC<column> is ['id', 'name'],
201
the following clause is created.
202

            
203
    book.id as id, book.name as name
204

            
205
These column name is for removing column name ambiguities.
206

            
207
If you remove some columns, use C<remove> option.
208

            
209
    my $column_clause = $model->column_clause(remove => ['id']);
210

            
211
If you add some column, use C<add> option.
212

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

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

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

            
222
=head2 C<delete_all>
223

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

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

            
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
231
    $table->method(
232
        count => sub {
233
            my $self = shift;
simplified DBIx::Custom::Mod...
Yuki Kimoto authored on 2011-01-02
234
        
table object call dbi object...
Yuki Kimoto authored on 2011-01-25
235
            return $self->select(column => 'count(*)', @_)
236
                        ->fetch_first->[0];
237
        }
238
    );
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
239
    
renamed experimental DBIx::C...
Yuki Kimoto authored on 2011-01-25
240
Add method to a L<DBIx::Custom::Table> object.
added experimental DBIx::Cus...
Yuki Kimoto authored on 2011-01-01
241

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

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

            
249
=head2 C<new>
250

            
251
    my $table = DBIx::Custom::Table->new;
252

            
253
Create a L<DBIx::Custom::Table> object.
254

            
255
=head2 C<select>
256

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

            
262
=head2 C<update>
263

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

            
269
=head2 C<update_all>
270

            
271
    $table->update_all(param => \%param);
272
    
273
Same as C<update_all()> of L<DBIx::Custom> except that
274
you don't have to specify table name.