X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FDFV.pm;h=fcf80fbf96eadd1577c59f1472a07645bf939250;hp=1a90bce09cad49353b31a8d27bf008754e62ba80;hb=dcc33148f1b562834e16f658e34270f3f581833c;hpb=3bd1e85e239f9f3c36abf8ec42a4109e27766395 diff --git a/lib/Maypole/Model/CDBI/DFV.pm b/lib/Maypole/Model/CDBI/DFV.pm index 1a90bce..fcf80fb 100644 --- a/lib/Maypole/Model/CDBI/DFV.pm +++ b/lib/Maypole/Model/CDBI/DFV.pm @@ -1,14 +1,9 @@ package Maypole::Model::CDBI::DFV; -use Class::C3; -use Maypole::Config; -use base qw(Maypole::Model::Base); use strict; -Maypole::Config->mk_accessors(qw(table_to_class)); - =head1 NAME -Maypole::Model::CDBI::Plain - Class::DBI model without ::Loader +Maypole::Model::CDBI::DFV - Class::DBI::DFV model for Maypole. =head1 SYNOPSIS @@ -38,6 +33,17 @@ as normal. Better still, it will also set use your DFV profile to validate input instead of CGI::Untaint. For teh win!! +=cut + +use Class::C3; +use Maypole::Config; +use Data::FormValidator; +use Maypole::Model::CDBI::AsForm; + +use base qw(Maypole::Model::Base); + +Maypole::Config->mk_accessors(qw(table_to_class _COLUMN_INFO)); + =head1 METHODS =head2 setup @@ -72,22 +78,6 @@ sub class_of { return $r->config->{table_to_class}->{$table}; } -=head2 add_model_superclass - -Adds model as superclass to model classes - -=cut - -sub add_model_superclass { - my ($class,$config) = @_; - foreach my $subclass ( @{ $config->classes } ) { - next if $subclass->isa("Maypole::Model::Base"); - no strict 'refs'; - push @{ $subclass . "::ISA" }, $config->model; - } - return; -} - =head2 adopt This class method is passed the name of a model class that represensts a table @@ -102,14 +92,228 @@ sub adopt { } } +=head1 Action Methods + +Action methods are methods that are accessed through web (or other public) interface. + +Inherited from L except do_edit (below) + +=head2 do_edit + +If there is an object in C<$r-Eobjects>, then it should be edited +with the parameters in C<$r-Eparams>; otherwise, a new object should +be created with those parameters, and put back into C<$r-Eobjects>. +The template should be changed to C, or C 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 $required_cols = $class->required_columns; + 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; + foreach my $error (keys %$errors) { + $r->template_args->{errors}{ucfirst($error)} = $errors->{$error} + } + + # 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 = { map { $_ => $r->{params}{$_} } $class->columns }; + + # 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) { + $class->_croak("No relationship for $accssr in " . ref($class)); + } + + 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 = { map { $_ => $r->{params}{$_} } $class->columns }; + my $obj = eval { My::DBI->create( $this_class_params ) }; + + my $dfv_results = ($obj) ? undef : $class->dfv_results->msgs ; + + # 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->_croak("No relationship for $accssr in " . ref($self)); + } + + 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 method fills C<$r-Eobjects> 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; +} + + + =head1 SEE ALSO L -L +L -=cut +=head1 AUTHOR + +Aaron Trevena. +=head1 LICENSE + +You may distribute this code under the same terms as Perl itself. + +=cut 1;