1 package Maypole::Model::CDBI::DFV;
6 Maypole::Model::CDBI::DFV - Class::DBI::DFV model for Maypole.
11 use 'Maypole::Application';
13 Foo->config->model("Maypole::Model::CDBI::DFV");
14 Foo->setup([qw/ Foo::SomeTable Foo::Other::Table /]);
16 # Look ma, no untainting
18 sub Foo::SomeTable::SomeAction : Exported {
26 This module allows you to use Maypole with previously set-up
27 L<Class::DBI> classes that use Class::DBI::DFV;
29 Simply call C<setup> with a list reference of the classes you're going to use,
30 and Maypole will work out the tables and set up the inheritance relationships
33 Better still, it will also set use your DFV profile to validate input instead
34 of CGI::Untaint. For teh win!!
39 use Data::FormValidator;
43 use Maypole::Model::CDBI::AsForm;
45 use base qw(Maypole::Model::CDBI::Base);
47 Maypole::Config->mk_accessors(qw(table_to_class _COLUMN_INFO));
53 This method is inherited from Maypole::Model::Base and calls setup_database,
54 which uses Class::DBI::Loader to create and load Class::DBI classes from
55 the given database schema.
59 This method loads the model classes for the application
64 my ( $self, $config, $namespace, $classes ) = @_;
65 $config->{classes} = $classes;
66 foreach my $class (@$classes) {
67 $namespace->load_model_subclass($class);
69 $namespace->model_classes_loaded(1);
70 $config->{table_to_class} = { map { $_->table => $_ } @$classes };
71 $config->{tables} = [ keys %{ $config->{table_to_class} } ];
76 returns class for given table
81 my ( $self, $r, $table ) = @_;
82 return $r->config->{table_to_class}->{$table};
87 This class method is passed the name of a model class that represensts a table
88 and allows the master model class to do any set-up required.
93 my ( $self, $child ) = @_;
94 if ( my $col = $child->stringify_column ) {
95 $child->columns( Stringify => $col );
101 Checks parameters against the DFV profile for the class, returns the results
104 my $dfv_results = __PACKAGE__->check_params($r->params);
109 my ($class,$params) = @_;
110 return Data::FormValidator->check($params, $class->dfv_profile);
114 =head1 Action Methods
116 Action methods are methods that are accessed through web (or other public) interface.
118 Inherited from L<Maypole::Model::CDBI::Base> except do_edit (below)
122 If there is an object in C<$r-E<gt>objects>, then it should be edited
123 with the parameters in C<$r-E<gt>params>; otherwise, a new object should
124 be created with those parameters, and put back into C<$r-E<gt>objects>.
125 The template should be changed to C<view>, or C<edit> if there were any
126 errors. A hash of errors will be passed to the template.
130 sub do_edit : Exported {
131 my ($class, $r, $obj) = @_;
133 my $config = $r->config;
134 my $table = $r->table;
136 # handle cancel button hit
137 if ( $r->params->{cancel} ) {
138 $r->template("list");
139 $r->objects( [$class->retrieve_all] );
146 ($obj,$errors) = $class->_do_update($r,$obj);
148 ($obj,$errors) = $class->_do_create($r);
151 # handle errors, if none, proceed to view the newly created/updated object
153 # pass errors to template
154 $r->template_args->{errors} = $errors;
155 # Set it up as it was:
156 $r->template_args->{cgi_params} = $r->params;
157 $r->template("edit");
159 $r->template("view");
162 $r->objects( $obj ? [$obj] : []);
166 my ($class,$r,$obj) = @_;
168 my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
171 if ( $dfv_results->has_missing ) { # missing fields
172 foreach my $field ( $dfv_results->missing ) {
173 $errors->{$field} = "$field is required";
176 if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
177 foreach my $field ( $dfv_results->invalid ) {
178 $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
183 my $this_class_params = {};
186 # NG changes start here.
187 # Code below fails to handle multi col PKs
188 my @pks = $class->columns('Primary');
190 foreach my $param ( $class->columns ) {
191 # next if ($param eq $class->columns('Primary'));
192 next if grep {/^${param}$/} @pks;
194 my $value = $r->params->{$param};
195 next unless (defined $value);
196 $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
199 # update or make other related (must_have, might_have, has_many etc )
201 foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
202 # get related object if it exists
203 my $rel_meta = $class->related_meta('r',$accssr);
205 $r->warn("[_do_update] No relationship for $accssr in " . ref($class));
209 my $rel_type = $rel_meta->{name};
210 my $fclass = $rel_meta->{foreign_class};
212 $rel_obj = $fclass->retrieve($r->params->{$accssr});
213 # update or create related object
214 ($rel_obj, $errs) = ($rel_obj)
215 ? $fclass->_do_update($r, $rel_obj)
216 : $obj->_create_related($accssr, $r->params);
217 $errors->{$accssr} = $errs if ($errs);
222 $obj->set( %$this_class_params );
226 return ($obj,$errors);
233 my $this_class_params = {};
234 foreach my $param ( $class->columns ) {
235 next if ($param eq $class->columns('Primary'));
236 my $value = $r->params->{$param};
237 next unless (defined $value);
238 $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
243 my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
244 if ($dfv_results->success) {
245 $obj = $class->create($this_class_params);
248 if ( $dfv_results->has_missing ) { # missing fields
249 foreach my $field ( $dfv_results->missing ) {
250 $errors->{$field} = "$field is required";
253 if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
254 foreach my $field ( $dfv_results->invalid ) {
255 $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
260 # Make other related (must_have, might_have, has_many etc )
262 foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
263 my ($rel_obj, $errs) = $obj->_create_related($accssr, $r->{params}{$accssr});
264 $errors->{$accssr} = $errs if ($errs);
267 return ($obj,$errors);
271 sub _create_related {
272 # self is object or class, accssr is accssr to relationship, params are
273 # data for relobject, and created is the array ref to store objs
274 my ( $self, $accssr, $params ) = @_;
275 $self->_croak ("Can't make related object without a parent $self object") unless (ref $self);
277 my $rel_meta = $self->related_meta('r',$accssr);
279 $self->_carp("[_create_related] No relationship for $accssr in " . ref($self));
283 my $rel_type = $rel_meta->{name};
284 my $fclass = $rel_meta->{foreign_class};
288 # Set up params for might_have, has_many, etc
289 if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
290 # Foreign Key meta data not very standardized in CDBI
291 my $fkey= $rel_meta->{args}{foreign_key} || $rel_meta->{foreign_column};
292 unless ($fkey) { die " Could not determine foreign key for $fclass"; }
293 my %data = (%$params, $fkey => $self->id);
294 %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} );
295 ($rel, $errs) = $fclass->_do_create(\%data);
298 ($rel, $errs) = $fclass->_do_create($params);
300 $self->$accssr($rel->id);
304 return ($rel, $errs);
310 Inherited from Maypole::Model::CDBI::Base.
312 This action deletes records
316 Inherited from Maypole::Model::CDBI::Base.
318 This action method searches for database records.
322 Inherited from Maypole::Model::CDBI::Base.
324 The C<list> method fills C<$r-E<gt>objects> with all of the
325 objects in the class. The results are paged using a pager.
332 # get COLUMN INFO from DB
333 $class->SUPER::_column_info() unless (ref $class->COLUMN_INFO);
335 # update with required columns from DFV Profile
336 my $profile = $class->dfv_profile;
337 $class->required_columns($profile->{required});
339 return $class->COLUMN_INFO;
346 L<Maypole::Model::Base>
348 L<Maypole::Model::CDBI::Base>
356 You may distribute this code under the same terms as Perl itself.