+=head2 check_params
+
+ Checks parameters against the DFV profile for the class, returns the results
+ of DFV's check.
+
+ my $dfv_results = __PACKAGE__->check_params($r->params);
+
+=cut
+
+sub check_params {
+ my ($class,$params) = @_;
+ return Data::FormValidator->check($params, $class->dfv_profile);
+}
+
+
+=head1 Action Methods
+
+Action methods are methods that are accessed through web (or other public) interface.
+
+Inherited from L<Maypole::Model::CDBI::Base> except do_edit (below)
+
+=head2 do_edit
+
+If there is an object in C<$r-E<gt>objects>, then it should be edited
+with the parameters in C<$r-E<gt>params>; otherwise, a new object should
+be created with those parameters, and put back into C<$r-E<gt>objects>.
+The template should be changed to C<view>, or C<edit> if there were any
+errors. A hash of errors will be passed to the template.
+
+=cut
+
+sub do_edit : Exported {
+ my ($class, $r, $obj) = @_;
+
+ my $config = $r->config;
+ my $table = $r->table;
+
+ # handle cancel button hit
+ if ( $r->params->{cancel} ) {
+ $r->template("list");
+ $r->objects( [$class->retrieve_all] );
+ return;
+ }
+
+
+ my $errors;
+ if ($obj) {
+ ($obj,$errors) = $class->_do_update($r,$obj);
+ } else {
+ ($obj,$errors) = $class->_do_create($r);
+ }
+
+ # handle errors, if none, proceed to view the newly created/updated object
+ if (ref $errors) {
+ # pass errors to template
+ $r->template_args->{errors} = $errors;
+ # Set it up as it was:
+ $r->template_args->{cgi_params} = $r->params;
+ $r->template("edit");
+ } else {
+ $r->template("view");
+ }
+
+ $r->objects( $obj ? [$obj] : []);
+}
+
+sub _do_update {
+ my ($class,$r,$obj) = @_;
+ my $errors;
+ my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
+
+ # handle dfv errors
+ if ( $dfv_results->has_missing ) { # missing fields
+ foreach my $field ( $dfv_results->missing ) {
+ $errors->{$field} = "$field is required";
+ }
+ }
+ if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
+ foreach my $field ( $dfv_results->invalid ) {
+ $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
+ }
+ }
+
+
+ my $this_class_params = {};
+
+
+ # NG changes start here.
+ # Code below fails to handle multi col PKs
+ my @pks = $class->columns('Primary');
+
+ foreach my $param ( $class->columns ) {
+ # next if ($param eq $class->columns('Primary'));
+ next if grep {/^${param}$/} @pks;
+
+ my $value = $r->params->{$param};
+ next unless (defined $value);
+ $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
+ }
+
+ # update or make other related (must_have, might_have, has_many etc )
+ unless ($errors) {
+ foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
+ # get related object if it exists
+ my $rel_meta = $class->related_meta('r',$accssr);
+ if (!$rel_meta) {
+ $r->warn("[_do_update] No relationship for $accssr in " . ref($class));
+ next;
+ }
+
+ my $rel_type = $rel_meta->{name};
+ my $fclass = $rel_meta->{foreign_class};
+ my ($rel_obj,$errs);
+ $rel_obj = $fclass->retrieve($r->params->{$accssr});
+ # update or create related object
+ ($rel_obj, $errs) = ($rel_obj)
+ ? $fclass->_do_update($r, $rel_obj)
+ : $obj->_create_related($accssr, $r->params);
+ $errors->{$accssr} = $errs if ($errs);
+ }
+ }
+
+ unless ($errors) {
+ $obj->set( %$this_class_params );
+ $obj->update;
+ }
+
+ return ($obj,$errors);
+}
+
+sub _do_create {
+ my ($class,$r) = @_;
+ my $errors;
+
+ my $this_class_params = {};
+ foreach my $param ( $class->columns ) {
+ next if ($param eq $class->columns('Primary'));
+ my $value = $r->params->{$param};
+ next unless (defined $value);
+ $this_class_params->{$param} = ( $value eq '' ) ? undef : $value;
+ }
+
+ my $obj;
+
+ my $dfv_results = Data::FormValidator->check($r->{params}, $class->dfv_profile);
+ if ($dfv_results->success) {
+ $obj = $class->create($this_class_params);
+ } else {
+ # handle dfv errors
+ if ( $dfv_results->has_missing ) { # missing fields
+ foreach my $field ( $dfv_results->missing ) {
+ $errors->{$field} = "$field is required";
+ }
+ }
+ if ( $dfv_results->has_invalid ) { # Print the name of invalid fields
+ foreach my $field ( $dfv_results->invalid ) {
+ $errors->{$field} = "$field is invalid: " . $dfv_results->invalid( $field );
+ }
+ }
+ }
+
+ # Make other related (must_have, might_have, has_many etc )
+ unless ($errors) {
+ foreach my $accssr ( grep ( !(exists $this_class_params->{$_}) , keys %{$r->{params}} ) ) {
+ my ($rel_obj, $errs) = $obj->_create_related($accssr, $r->{params}{$accssr});
+ $errors->{$accssr} = $errs if ($errs);
+ }
+ }
+ return ($obj,$errors);
+}
+
+
+sub _create_related {
+ # self is object or class, accssr is accssr to relationship, params are
+ # data for relobject, and created is the array ref to store objs
+ my ( $self, $accssr, $params ) = @_;
+ $self->_croak ("Can't make related object without a parent $self object") unless (ref $self);
+ my $created = [];
+ my $rel_meta = $self->related_meta('r',$accssr);
+ if (!$rel_meta) {
+ $self->_carp("[_create_related] No relationship for $accssr in " . ref($self));
+ return;
+ }
+
+ my $rel_type = $rel_meta->{name};
+ my $fclass = $rel_meta->{foreign_class};
+
+ my ($rel, $errs);
+
+ # Set up params for might_have, has_many, etc
+ if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
+ # Foreign Key meta data not very standardized in CDBI
+ my $fkey= $rel_meta->{args}{foreign_key} || $rel_meta->{foreign_column};
+ unless ($fkey) { die " Could not determine foreign key for $fclass"; }
+ my %data = (%$params, $fkey => $self->id);
+ %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} );
+ ($rel, $errs) = $fclass->_do_create(\%data);
+ }
+ else {
+ ($rel, $errs) = $fclass->_do_create($params);
+ unless ($errs) {
+ $self->$accssr($rel->id);
+ $self->update;
+ }
+ }
+ return ($rel, $errs);
+}
+
+
+=head2 do_delete
+
+Inherited from Maypole::Model::CDBI::Base.
+
+This action deletes records
+
+=head2 do_search
+
+Inherited from Maypole::Model::CDBI::Base.
+
+This action method searches for database records.
+
+=head2 list
+
+Inherited from Maypole::Model::CDBI::Base.
+
+The C<list> method fills C<$r-E<gt>objects> with all of the
+objects in the class. The results are paged using a pager.
+
+=cut
+
+sub _column_info {
+ my $class = shift;
+
+ # get COLUMN INFO from DB
+ $class->SUPER::_column_info() unless (ref $class->COLUMN_INFO);
+
+ # update with required columns from DFV Profile
+ my $profile = $class->dfv_profile;
+ $class->required_columns($profile->{required});
+
+ return $class->COLUMN_INFO;
+}
+
+
+