line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package CatalystX::CRUD::Model; |
2
|
5
|
|
|
5
|
|
1226
|
use strict; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
155
|
|
3
|
5
|
|
|
5
|
|
33
|
use warnings; |
|
5
|
|
|
|
|
14
|
|
|
5
|
|
|
|
|
137
|
|
4
|
5
|
|
|
5
|
|
26
|
use MRO::Compat; |
|
5
|
|
|
|
|
30
|
|
|
5
|
|
|
|
|
149
|
|
5
|
5
|
|
|
5
|
|
32
|
use mro 'c3'; |
|
5
|
|
|
|
|
9
|
|
|
5
|
|
|
|
|
65
|
|
6
|
5
|
|
|
|
|
2774
|
use base qw( |
7
|
|
|
|
|
|
|
Catalyst::Component::ACCEPT_CONTEXT |
8
|
|
|
|
|
|
|
CatalystX::CRUD |
9
|
|
|
|
|
|
|
Catalyst::Model |
10
|
5
|
|
|
5
|
|
199
|
); |
|
5
|
|
|
|
|
15
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
our $VERSION = '0.58'; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
__PACKAGE__->mk_accessors(qw( object_class page_size )); |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
__PACKAGE__->config( page_size => 50 ); |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=head1 NAME |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
CatalystX::CRUD::Model - base class for CRUD models |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
=head1 SYNOPSIS |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
package MyApp::Model::Foo; |
25
|
|
|
|
|
|
|
use base qw( CatalystX::CRUD::Model ); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
__PACKAGE__->config( |
28
|
|
|
|
|
|
|
object_class => 'MyApp::Foo', |
29
|
|
|
|
|
|
|
page_size => 50, |
30
|
|
|
|
|
|
|
); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# must define the following methods |
33
|
|
|
|
|
|
|
sub new_object { } |
34
|
|
|
|
|
|
|
sub fetch { } |
35
|
|
|
|
|
|
|
sub search { } |
36
|
|
|
|
|
|
|
sub iterator { } |
37
|
|
|
|
|
|
|
sub count { } |
38
|
|
|
|
|
|
|
sub search_related { } |
39
|
|
|
|
|
|
|
sub iterator_related { } |
40
|
|
|
|
|
|
|
sub count_related { } |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
1; |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
=head1 DESCRIPTION |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
CatalystX::CRUD::Model provides a high-level API for writing Model |
47
|
|
|
|
|
|
|
classes. CatalystX::CRUD::Model methods typically return CatalystX::CRUD::Object |
48
|
|
|
|
|
|
|
objects. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
This documentation is intended for Model developers. |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
=head1 CONFIGURATION |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
You may configure your CXCM-derived Models in the usual way (see the Catalyst |
55
|
|
|
|
|
|
|
Manual). |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
If the C<object_class> key/value pair is set at initialization time, the value |
58
|
|
|
|
|
|
|
will be stored in the object_class() accessor. This feature is intended as a |
59
|
|
|
|
|
|
|
convenience for setting the name of the CatalystX::CRUD::Object class to which |
60
|
|
|
|
|
|
|
your CatalystX::CRUD::Model acts as an interface. |
61
|
|
|
|
|
|
|
|
62
|
|
|
|
|
|
|
=head1 METHODS |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
CatalystX::CRUD::Model inherits from Catalyst::Component::ACCEPT_CONTEXT |
65
|
|
|
|
|
|
|
and Catalyst::Model. New and overridden methods are documented here. |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 context |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
This accessor is available via Catalyst::Component::ACCEPT_CONTEXT and |
70
|
|
|
|
|
|
|
returns the C<$c> value for the current request. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
This method is not implemented at the CatalystX::CRUD::Model level but is |
73
|
|
|
|
|
|
|
highlighted here in order to remind developers that it exists. |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 object_class |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
The object_class() accessor is defined for your convenience. It is set |
78
|
|
|
|
|
|
|
by the default Xsetup() method if a key called C<object_class> is present |
79
|
|
|
|
|
|
|
in config() at initialization time. |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
=cut |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
=head2 new |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Overrides the Catalyst::Model new() method to call Xsetup(). |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
=cut |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub new { |
90
|
8
|
|
|
8
|
1
|
318080
|
my ( $class, $c, @arg ) = @_; |
91
|
8
|
|
|
|
|
45
|
my $self = $class->next::method( $c, @arg ); |
92
|
8
|
|
|
|
|
17602
|
$self->Xsetup( $c, @arg ); |
93
|
8
|
|
|
|
|
31
|
return $self; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
=head2 Xsetup |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Called by new() at application startup time. Override this method |
99
|
|
|
|
|
|
|
in order to set up your model in whatever way you require. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
Xsetup() is called by new(), which in turn is called by COMPONENT(). |
102
|
|
|
|
|
|
|
Keep that order in mind when overriding Xsetup(), notably that config() |
103
|
|
|
|
|
|
|
has already been merged by the time Xsetup() is called. |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
=cut |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
sub Xsetup { |
108
|
8
|
|
|
8
|
1
|
131
|
my ( $self, $c, $arg ) = @_; |
109
|
|
|
|
|
|
|
|
110
|
8
|
50
|
|
|
|
70
|
if ( !$self->object_class ) { |
111
|
0
|
|
|
|
|
0
|
$self->throw_error("must configure an object_class"); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
8
|
|
|
|
|
1302
|
my $object_class = $self->object_class; |
115
|
8
|
|
|
|
|
1490
|
eval "require $object_class"; |
116
|
8
|
50
|
|
|
|
55
|
if ($@) { |
117
|
0
|
|
|
|
|
0
|
$self->throw_error("$object_class could not be loaded: $@"); |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
8
|
|
|
|
|
23
|
return $self; |
121
|
|
|
|
|
|
|
} |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
=head2 page_size |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
Returns the C<page_size> set in config(). |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
=cut |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
=head2 new_object |
130
|
|
|
|
|
|
|
|
131
|
|
|
|
|
|
|
Returns CatalystX::CRUD::Object->new(). A sane default, assuming |
132
|
|
|
|
|
|
|
C<object_class> is set in config(), is implemented in this base class. |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
=head1 REQUIRED METHODS |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
CXCM subclasses need to implement at least the following methods: |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
=over |
140
|
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
=item fetch( I<args> ) |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
Should return the equivalent of |
144
|
|
|
|
|
|
|
CatalystX::CRUD::Object->new( I<args> )->read(). |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item search( I<query> ) |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
Returns zero or more CXCO instances as an array or arrayref. |
149
|
|
|
|
|
|
|
I<query> may be the return value of make_query(). |
150
|
|
|
|
|
|
|
|
151
|
|
|
|
|
|
|
=item iterator( I<query> ) |
152
|
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
Like search() but returns an iterator conforming to the |
154
|
|
|
|
|
|
|
CatalystX::CRUD::Iterator API. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=item count( I<query> ) |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
Like search() but returns an integer. |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item search_related( I<obj>, I<relationship> ) |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
Returns zero or more CXCO instances like search(). |
163
|
|
|
|
|
|
|
The instances are related to I<obj> via I<relationship>. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=item iterator_related( I<obj>, I<relationship> ) |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
Like search_related() but returns an iterator. |
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
=item count_related( I<obj>, I<relationship> ) |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
Like search_related() but returns an integer. |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
=back |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=cut |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub new_object { |
178
|
64
|
|
|
64
|
1
|
55992
|
my $self = shift; |
179
|
64
|
50
|
|
|
|
191
|
if ( $self->object_class ) { |
180
|
64
|
|
|
|
|
8291
|
return $self->object_class->new(@_); |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
else { |
183
|
0
|
|
|
|
|
|
return $self->throw_error("must implement new_object()"); |
184
|
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
|
} |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
0
|
1
|
|
sub fetch { shift->throw_error("must implement fetch") } |
188
|
0
|
|
|
0
|
1
|
|
sub search { shift->throw_error("must implement search") } |
189
|
0
|
|
|
0
|
1
|
|
sub iterator { shift->throw_error("must implement iterator") } |
190
|
0
|
|
|
0
|
1
|
|
sub count { shift->throw_error("must implement count") } |
191
|
0
|
|
|
0
|
1
|
|
sub search_related { shift->throw_error("must implement search_related") } |
192
|
0
|
|
|
0
|
1
|
|
sub iterator_related { shift->throw_error("must implement iterator_related") } |
193
|
0
|
|
|
0
|
1
|
|
sub count_related { shift->throw_error("must implement count_related") } |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
=head1 OPTIONAL METHODS |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
Catalyst components accessing CXCM instances may need to access |
198
|
|
|
|
|
|
|
model-specific logic without necessarily knowing what kind of model they |
199
|
|
|
|
|
|
|
are accessing. |
200
|
|
|
|
|
|
|
An example would be a Controller that wants to remain agnostic about the kind |
201
|
|
|
|
|
|
|
of data storage a particular model implements, but also needs to |
202
|
|
|
|
|
|
|
create a model-specific query based on request parameters. |
203
|
|
|
|
|
|
|
|
204
|
|
|
|
|
|
|
$c->model('Foo')->search(@arg); # @arg depends upon what Foo is |
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
To support this high level of abstraction, CXCM classes may implement |
207
|
|
|
|
|
|
|
the following optional methods. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=over |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
=item make_query |
212
|
|
|
|
|
|
|
|
213
|
|
|
|
|
|
|
Should return appropriate values for passing to search(), iterator() and |
214
|
|
|
|
|
|
|
count(). Example of use: |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
# in a CXCM subclass called MyApp::Model::Foo |
217
|
|
|
|
|
|
|
sub search { |
218
|
|
|
|
|
|
|
my $self = shift; |
219
|
|
|
|
|
|
|
my @arg = @_; |
220
|
|
|
|
|
|
|
unless(@arg) { |
221
|
|
|
|
|
|
|
@arg = $self->make_query; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
# search code here |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
return $results; |
226
|
|
|
|
|
|
|
} |
227
|
|
|
|
|
|
|
|
228
|
|
|
|
|
|
|
sub make_query { |
229
|
|
|
|
|
|
|
my $self = shift; |
230
|
|
|
|
|
|
|
my $c = $self->context; |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
# use $c->req to get at params() etc. |
233
|
|
|
|
|
|
|
# and create a query |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
return $query; |
236
|
|
|
|
|
|
|
} |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
# elsewhere in a controller |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
my $results = $c->model('Foo')->search; # notice no @arg necessary since |
241
|
|
|
|
|
|
|
# it will default to |
242
|
|
|
|
|
|
|
# $c->model('Foo')->make_query() |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
|
245
|
|
|
|
|
|
|
=item add_related( I<obj>, I<rel_name>, I<foreign_value> ) |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
Associate foreign object identified by I<foreign_value> with I<obj> |
248
|
|
|
|
|
|
|
via the relationship I<rel_name>. |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
It is up to the subclass to implement this method. |
251
|
|
|
|
|
|
|
|
252
|
|
|
|
|
|
|
=item rm_related( I<obj>, I<rel_name>, I<foreign_value> ) |
253
|
|
|
|
|
|
|
|
254
|
|
|
|
|
|
|
Dissociate foreign object identified by I<foreign_value> from I<obj> |
255
|
|
|
|
|
|
|
via the relationship I<rel_name>. |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
It is up to the subclass to implement this method. |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
=item put_related( I<obj>, I<rel_name>, I<foreign_value> ) |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
Create new related foreign object. Unlike add_related(), |
262
|
|
|
|
|
|
|
the foreign object need not already exist. put_related() |
263
|
|
|
|
|
|
|
should be idempotent. |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
=item remove_related |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
remove_related() is an alias for rm_related(). |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
=item find_related( I<obj>, I<rel_name>, I<foreign_value> ) |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
Return related object for I<foreign_value> based on I<rel_name> |
272
|
|
|
|
|
|
|
for I<obj>. |
273
|
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
=item has_relationship( I<obj>, I<rel_name> ) |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
Should return true or false as to whether I<rel_name> exists for |
277
|
|
|
|
|
|
|
I<obj>. |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
It is up to the subclass to implement this method. |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
=back |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
=cut |
284
|
|
|
|
|
|
|
|
285
|
0
|
|
|
0
|
1
|
|
sub make_query { shift->throw_error("must implement make_query()") } |
286
|
0
|
|
|
0
|
1
|
|
sub add_related { shift->throw_error("must implement add_related()") } |
287
|
0
|
|
|
0
|
1
|
|
sub rm_related { shift->throw_error("must implement rm_related()") } |
288
|
|
|
|
|
|
|
*remove_related = \&rm_related; |
289
|
0
|
|
|
0
|
1
|
|
sub find_related { shift->throw_error("must implement view_related()") } |
290
|
0
|
|
|
0
|
1
|
|
sub put_related { shift->throw_error("must implement put_related()") } |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
sub has_relationship { |
293
|
0
|
|
|
0
|
1
|
|
shift->throw_error("must implement has_relationship()"); |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
1; |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
__END__ |
299
|
|
|
|
|
|
|
|
300
|
|
|
|
|
|
|
=head1 AUTHOR |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
Peter Karman, C<< <perl at peknet.com> >> |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
=head1 BUGS |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
Please report any bugs or feature requests to |
307
|
|
|
|
|
|
|
C<bug-catalystx-crud at rt.cpan.org>, or through the web interface at |
308
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CatalystX-CRUD>. |
309
|
|
|
|
|
|
|
I will be notified, and then you'll automatically be notified of progress on |
310
|
|
|
|
|
|
|
your bug as I make changes. |
311
|
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
=head1 SUPPORT |
313
|
|
|
|
|
|
|
|
314
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
perldoc CatalystX::CRUD |
317
|
|
|
|
|
|
|
|
318
|
|
|
|
|
|
|
You can also look for information at: |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=over 4 |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
=item * Mailing List |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
L<https://groups.google.com/forum/#!forum/catalystxcrud> |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
=item * AnnoCPAN: Annotated CPAN documentation |
327
|
|
|
|
|
|
|
|
328
|
|
|
|
|
|
|
L<http://annocpan.org/dist/CatalystX-CRUD> |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
=item * CPAN Ratings |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
L<http://cpanratings.perl.org/d/CatalystX-CRUD> |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
=item * RT: CPAN's request tracker |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=CatalystX-CRUD> |
337
|
|
|
|
|
|
|
|
338
|
|
|
|
|
|
|
=item * Search CPAN |
339
|
|
|
|
|
|
|
|
340
|
|
|
|
|
|
|
L<http://search.cpan.org/dist/CatalystX-CRUD> |
341
|
|
|
|
|
|
|
|
342
|
|
|
|
|
|
|
=back |
343
|
|
|
|
|
|
|
|
344
|
|
|
|
|
|
|
=head1 COPYRIGHT & LICENSE |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
Copyright 2007 Peter Karman, all rights reserved. |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
349
|
|
|
|
|
|
|
under the same terms as Perl itself. |
350
|
|
|
|
|
|
|
|
351
|
|
|
|
|
|
|
=cut |