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!!
38 use Data::FormValidator;
42 use Maypole::Model::CDBI::AsForm;
44 use base qw(Maypole::Model::CDBI::Base);
46 Maypole::Config->mk_accessors(qw(table_to_class _COLUMN_INFO));
52 This method is inherited from Maypole::Model::Base and calls setup_database,
53 which uses Class::DBI::Loader to create and load Class::DBI classes from
54 the given database schema.
58 This method loads the model classes for the application
63 my ( $self, $config, $namespace, $classes ) = @_;
64 $config->{classes} = $classes;
65 foreach my $class (@$classes) {
66 $namespace->load_model_subclass($class);
68 $namespace->model_classes_loaded(1);
69 $config->{table_to_class} = { map { $_->table => $_ } @$classes };
70 $config->{tables} = [ keys %{ $config->{table_to_class} } ];
75 returns class for given table
80 my ( $self, $r, $table ) = @_;
81 return $r->config->{table_to_class}->{$table};
86 This class method is passed the name of a model class that represensts a table
87 and allows the master model class to do any set-up required.
92 my ( $self, $child ) = @_;
93 if ( my $col = $child->stringify_column ) {
94 $child->columns( Stringify => $col );
100 Checks parameters against the DFV profile for the class, returns the results
103 my $dfv_results = __PACKAGE__->check_params($r->params);
108 my ($class,$params) = @_;
109 return Data::FormValidator->check($params, $class->dfv_profile);
113 =head1 Action Methods
115 Action methods are methods that are accessed through web (or other public) interface.
117 Inherited from L<Maypole::Model::CDBI::Base> except do_edit (below)
121 If there is an object in C<$r-E<gt>objects>, then it should be edited
122 with the parameters in C<$r-E<gt>params>; otherwise, a new object should
123 be created with those parameters, and put back into C<$r-E<gt>objects>.
124 The template should be changed to C<view>, or C<edit> if there were any
125 errors. A hash of errors will be passed to the template.
129 sub do_edit : Exported {
130 my ($class, $r, $obj) = @_;
132 my $config = $r->config;
133 my $table = $r->table;
135 # handle cancel button hit
136 if ( $r->params->{cancel} ) {
137 $r->template("list");
138 $r->objects( [$class->retrieve_all] );
145 ($obj,$errors) = $class->_do_update($r,$obj);
147 ($obj,$errors) = $class->_do_create($r);
150 # handle errors, if none, proceed to view the newly created/updated object
152 # pass errors to template
153 $r->template_args->{errors} = $errors;
154 # Set it up as it was:
155 $r->template_args->{cgi_params} = $r->params;
156 $r->template("edit");
158 $r->template("view");
161 $r->objects( $obj ? [$obj] : []);
165 my ($class,$r,$obj) = @_;
167 my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
170 if ( $dfv_results->has_missing ) { # missing fields
171 foreach my $field ( $dfv_results->missing ) {
172 $errors->{$field} = "$field is required";
175 if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
176 foreach my $field ( $dfv_results->invalid ) {
177 $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
182 my $this_class_params = {};
185 # NG changes start here.
186 # Code below fails to handle multi col PKs
187 my @pks = $class->columns('Primary');
189 foreach my $param ( $class->columns ) {
190 # next if ($param eq $class->columns('Primary'));
191 next if grep {/^${param}$/} @pks;
193 my $value = $r->params->{$param};
194 next unless (defined $value);
195 $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
198 # update or make other related (must_have, might_have, has_many etc )
200 foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
201 # get related object if it exists
202 my $rel_meta = $class->related_meta('r',$accssr);
204 $r->warn("[_do_update] No relationship for $accssr in " . ref($class));
208 my $rel_type = $rel_meta->{name};
209 my $fclass = $rel_meta->{foreign_class};
211 $rel_obj = $fclass->retrieve($r->params->{$accssr});
212 # update or create related object
213 ($rel_obj, $errs) = ($rel_obj)
214 ? $fclass->_do_update($r, $rel_obj)
215 : $obj->_create_related($accssr, $r->params);
216 $errors->{$accssr} = $errs if ($errs);
221 $obj->set( %$this_class_params );
225 return ($obj,$errors);
232 my $this_class_params = {};
233 foreach my $param ( $class->columns ) {
234 next if ($param eq $class->columns('Primary'));
235 my $value = $r->params->{$param};
236 next unless (defined $value);
237 $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
242 my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
243 if ($dfv_results->success) {
244 $obj = $class->create($this_class_params);
247 if ( $dfv_results->has_missing ) { # missing fields
248 foreach my $field ( $dfv_results->missing ) {
249 $errors->{$field} = "$field is required";
252 if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
253 foreach my $field ( $dfv_results->invalid ) {
254 $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
259 # Make other related (must_have, might_have, has_many etc )
261 foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
262 my ($rel_obj, $errs) = $obj->_create_related($accssr, $r->{params}{$accssr});
263 $errors->{$accssr} = $errs if ($errs);
266 return ($obj,$errors);
270 sub _create_related {
271 # self is object or class, accssr is accssr to relationship, params are
272 # data for relobject, and created is the array ref to store objs
273 my ( $self, $accssr, $params ) = @_;
274 $self->_croak ("Can't make related object without a parent $self object") unless (ref $self);
276 my $rel_meta = $self->related_meta('r',$accssr);
278 $self->_carp("[_create_related] No relationship for $accssr in " . ref($self));
282 my $rel_type = $rel_meta->{name};
283 my $fclass = $rel_meta->{foreign_class};
287 # Set up params for might_have, has_many, etc
288 if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
289 # Foreign Key meta data not very standardized in CDBI
290 my $fkey= $rel_meta->{args}{foreign_key} || $rel_meta->{foreign_column};
291 unless ($fkey) { die " Could not determine foreign key for $fclass"; }
292 my %data = (%$params, $fkey => $self->id);
293 %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} );
294 ($rel, $errs) = $fclass->_do_create(\%data);
297 ($rel, $errs) = $fclass->_do_create($params);
299 $self->$accssr($rel->id);
303 return ($rel, $errs);
309 Inherited from Maypole::Model::CDBI::Base.
311 This action deletes records
315 Inherited from Maypole::Model::CDBI::Base.
317 This action method searches for database records.
321 Inherited from Maypole::Model::CDBI::Base.
323 The C<list> method fills C<$r-E<gt>objects> with all of the
324 objects in the class. The results are paged using a pager.
331 # get COLUMN INFO from DB
332 $class->SUPER::_column_info() unless (ref $class->COLUMN_INFO);
334 # update with required columns from DFV Profile
335 my $profile = $class->dfv_profile;
336 $class->required_columns($profile->{required});
338 return $class->COLUMN_INFO;
345 L<Maypole::Model::Base>
347 L<Maypole::Model::CDBI::Base>
355 You may distribute this code under the same terms as Perl itself.