added common test executing ...
|
1 |
package DBIx::Custom::Model; |
2 |
use Object::Simple -base; |
|
3 | ||
4 |
use Carp 'croak'; |
|
5 |
use DBIx::Custom::Util '_subname'; |
|
6 | ||
7 |
# Carp trust relationship |
|
8 |
push @DBIx::Custom::CARP_NOT, __PACKAGE__; |
|
9 | ||
10 |
has [qw/dbi table/], |
|
11 |
bind_type => sub { [] }, |
|
12 |
columns => sub { [] }, |
|
13 |
join => sub { [] }, |
|
14 |
primary_key => sub { [] }; |
|
15 | ||
16 |
our $AUTOLOAD; |
|
17 | ||
18 |
sub AUTOLOAD { |
|
19 |
my $self = shift; |
|
20 | ||
21 |
# Method name |
|
22 |
my ($package, $mname) = $AUTOLOAD =~ /^([\w\:]+)\:\:(\w+)$/; |
|
23 | ||
24 |
# Method |
|
25 |
$self->{_methods} ||= {}; |
|
26 |
if (my $method = $self->{_methods}->{$mname}) { |
|
27 |
return $self->$method(@_) |
|
28 |
} |
|
29 |
elsif (my $dbi_method = $self->dbi->can($mname)) { |
|
30 |
$self->dbi->$dbi_method(@_); |
|
31 |
} |
|
32 |
elsif ($self->{dbh} && (my $dbh_method = $self->dbh->can($mname))) { |
|
33 |
$self->dbi->dbh->$dbh_method(@_); |
|
34 |
} |
|
35 |
else { |
|
36 |
croak qq{Can't locate object method "$mname" via "$package" } |
|
37 |
. _subname; |
|
38 |
} |
|
39 |
} |
|
40 | ||
41 |
my @methods = qw/insert insert_at update update_at update_all |
|
42 |
delete delete_at delete_all select select_at/; |
|
43 |
foreach my $method (@methods) { |
|
44 | ||
45 |
my $code = sub { |
|
46 |
my $self = shift; |
|
47 | ||
48 |
my @args = ( |
|
49 |
table => $self->table, |
|
50 |
bind_type => $self->bind_type, |
|
51 |
primary_key => $self->primary_key, |
|
52 |
type => $self->type, # DEPRECATED! |
|
53 |
); |
|
54 |
push @args, (join => $self->join) if $method =~ /^select/; |
|
55 |
unshift @args, shift if @_ % 2; |
|
56 |
|
|
57 |
$self->dbi->$method(@args, @_); |
|
58 |
}; |
|
59 |
|
|
60 |
no strict 'refs'; |
|
61 |
my $class = __PACKAGE__; |
|
62 |
*{"${class}::$method"} = $code; |
|
63 |
} |
|
64 | ||
65 |
sub DESTROY { } |
|
66 | ||
67 |
sub method { |
|
68 |
my $self = shift; |
|
69 |
|
|
70 |
# Merge |
|
71 |
my $methods = ref $_[0] eq 'HASH' ? $_[0] : {@_}; |
|
72 |
$self->{_methods} = {%{$self->{_methods} || {}}, %$methods}; |
|
73 |
|
|
74 |
return $self; |
|
75 |
} |
|
76 | ||
77 |
sub mycolumn { |
|
78 |
my $self = shift; |
|
79 |
my $table = shift unless ref $_[0]; |
|
80 |
my $columns = shift; |
|
81 |
|
|
82 |
$table ||= $self->table || ''; |
|
83 |
$columns ||= $self->columns; |
|
84 |
|
|
85 |
return $self->dbi->mycolumn($table, $columns); |
|
86 |
} |
|
87 | ||
88 |
sub new { |
|
89 |
my $self = shift->SUPER::new(@_); |
|
90 |
|
|
91 |
# Check attribute names |
|
92 |
my @attrs = keys %$self; |
|
93 |
foreach my $attr (@attrs) { |
|
94 |
croak qq{"$attr" is invalid attribute name } . _subname |
|
95 |
unless $self->can($attr); |
|
96 |
} |
|
97 |
|
|
98 |
return $self; |
|
99 |
} |
|
100 | ||
101 |
# DEPRECATED! |
|
102 |
has 'filter'; |
|
103 |
has 'name'; |
|
104 |
has type => sub { [] }; |
|
105 | ||
106 |
1; |
|
107 | ||
108 |
=head1 NAME |
|
109 | ||
110 |
DBIx::Custom::Model - Model |
|
111 | ||
112 |
=head1 SYNOPSIS |
|
113 | ||
114 |
use DBIx::Custom::Table; |
|
115 | ||
116 |
my $table = DBIx::Custom::Model->new(table => 'books'); |
|
117 | ||
118 |
=head1 ATTRIBUTES |
|
119 | ||
120 |
=head2 C<dbi> |
|
121 | ||
122 |
my $dbi = $model->dbi; |
|
123 |
$model = $model->dbi($dbi); |
|
124 | ||
125 |
L<DBIx::Custom> object. |
|
126 | ||
127 |
=head2 C<join> |
|
128 | ||
129 |
my $join = $model->join; |
|
130 |
$model = $model->join( |
|
131 |
['left outer join company on book.company_id = company.id'] |
|
132 |
); |
|
133 |
|
|
134 |
Join clause, this value is passed to C<select> method. |
|
135 | ||
136 |
=head2 C<primary_key> |
|
137 | ||
138 |
my $primary_key = $model->primary_key; |
|
139 |
$model = $model->primary_key(['id', 'number']); |
|
140 | ||
141 |
Primary key,this is passed to C<insert>, C<update>, |
|
142 |
C<delete>, and C<select> method. |
|
143 | ||
144 |
=head2 C<table> |
|
145 | ||
146 |
my $table = $model->table; |
|
147 |
$model = $model->table('book'); |
|
148 | ||
149 |
Table name, this is passed to C<select> method. |
|
150 | ||
151 |
=head2 C<bind_type> |
|
152 | ||
153 |
my $type = $model->bind_type; |
|
154 |
$model = $model->bind_type(['image' => DBI::SQL_BLOB]); |
|
155 |
|
|
156 |
Database data type, this is used as type optioon of C<insert>, |
|
157 |
C<update>, C<update_all>, C<delete>, C<delete_all>, |
|
158 |
C<select>, and C<execute> method |
|
159 | ||
160 |
=head1 METHODS |
|
161 | ||
162 |
L<DBIx::Custom::Model> inherits all methods from L<Object::Simple>, |
|
163 |
and you can use all methods of L<DBIx::Custom> and L<DBI> |
|
164 |
and implements the following new ones. |
|
165 | ||
166 |
=head2 C<delete> |
|
167 | ||
168 |
$table->delete(...); |
|
169 |
|
|
170 |
Same as C<delete> of L<DBIx::Custom> except that |
|
171 |
you don't have to specify C<table> option. |
|
172 | ||
173 |
=head2 C<delete_all> |
|
174 | ||
175 |
$table->delete_all(...); |
|
176 |
|
|
177 |
Same as C<delete_all> of L<DBIx::Custom> except that |
|
178 |
you don't have to specify C<table> option. |
|
179 | ||
180 |
=head2 C<insert> |
|
181 | ||
182 |
$table->insert(...); |
|
183 |
|
|
184 |
Same as C<insert> of L<DBIx::Custom> except that |
|
185 |
you don't have to specify C<table> option. |
|
186 | ||
187 |
=head2 C<method> |
|
188 | ||
189 |
$model->method( |
|
190 |
update_or_insert => sub { |
|
191 |
my $self = shift; |
|
192 |
|
|
193 |
# ... |
|
194 |
}, |
|
195 |
find_or_create => sub { |
|
196 |
my $self = shift; |
|
197 |
|
|
198 |
# ... |
|
199 |
); |
|
200 | ||
201 |
Register method. These method is called directly from L<DBIx::Custom::Model> object. |
|
202 | ||
203 |
$model->update_or_insert; |
|
204 |
$model->find_or_create; |
|
205 | ||
206 |
=head2 C<mycolumn> |
|
207 | ||
208 |
my $column = $self->mycolumn; |
|
209 |
my $column = $self->mycolumn(book => ['author', 'title']); |
|
210 |
my $column = $self->mycolumn(['author', 'title']); |
|
211 | ||
212 |
Create column clause for myself. The follwoing column clause is created. |
|
213 | ||
214 |
book.author as author, |
|
215 |
book.title as title |
|
216 | ||
217 |
If table name is ommited, C<table> attribute of the model is used. |
|
218 |
If column names is omitted, C<columns> attribute of the model is used. |
|
219 | ||
220 |
=head2 C<new> |
|
221 | ||
222 |
my $table = DBIx::Custom::Table->new; |
|
223 | ||
224 |
Create a L<DBIx::Custom::Table> object. |
|
225 | ||
226 |
=head2 C<select> |
|
227 | ||
228 |
$table->select(...); |
|
229 |
|
|
230 |
Same as C<select> of L<DBIx::Custom> except that |
|
231 |
you don't have to specify C<table> option. |
|
232 | ||
233 |
=head2 C<update> |
|
234 | ||
235 |
$table->update(...); |
|
236 |
|
|
237 |
Same as C<update> of L<DBIx::Custom> except that |
|
238 |
you don't have to specify C<table> option. |
|
239 | ||
240 |
=head2 C<update_all> |
|
241 | ||
242 |
$table->update_all(param => \%param); |
|
243 |
|
|
244 |
Same as C<update_all> of L<DBIx::Custom> except that |
|
245 |
you don't have to specify table name. |
|
246 | ||
247 |
=cut |