From 5c776a61a4b51aa2dc97c08fcb5feffd20f14063 Mon Sep 17 00:00:00 2001 From: biopete Date: Wed, 12 Jul 2006 05:01:52 +0000 Subject: [PATCH] Finally, FromCGI seems functional and the documentation is accurate at first read. Added "add_to_from_cgi" because it was too hard for Drinker to drink a Pint without it. And it was easy. Still need official tests. Arghh. git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@506 48953598-375a-da11-a14b-00016c27c3ee --- lib/Maypole/Model/CDBI/FromCGI.pm | 154 ++++++++++++++++++++++-------- 1 file changed, 114 insertions(+), 40 deletions(-) diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm index 0d1f86a..8c28c2c 100644 --- a/lib/Maypole/Model/CDBI/FromCGI.pm +++ b/lib/Maypole/Model/CDBI/FromCGI.pm @@ -1,12 +1,26 @@ package Maypole::Model::CDBI::FromCGI; use strict; + =head1 NAME Maypole::Model:CDBI::FromCGI - Validate form input and populate Model objects =head1 SYNOPSIS -... + $obj = $class->create_from_cgi($r); + $obj = $class->create_from_cgi($r, { params => {data1=>...}, required => [..], + ignore => [...], all => [...]); + $obj = $class->create_from_cgi($h, $options); # CDBI::FromCGI style, see docs + + $obj->update_from_cgi($r); + $obj->update_from_cgi($h, $options); + + $obj = $obj->add_to_from_cgi($r); + $obj = $obj->add_to_from_cgi($r, { params => {...} } ); + + # This does not work like in CDBI::FromCGI and probably never will : + # $class->update_from_cgi($h, @columns); + =head1 DESCRIPTION @@ -26,7 +40,7 @@ use Maypole::Constants; use CGI::Untaint::Maypole; our $Untainter = 'CGI::Untaint::Maypole'; -our @EXPORT = qw/update_from_cgi create_from_cgi untaint_columns +our @EXPORT = qw/update_from_cgi create_from_cgi untaint_columns add_to_from_cgi cgi_update_errors untaint_type validate_inputs validate_all _do_update_all _do_create_all _create_related classify_form_inputs/; @@ -62,7 +76,7 @@ sub untaint_columns { =head2 untaint_type - gets/sets untaint_type for a column, no equivilent in Class::DBI::FromCGI + gets the untaint type for a column as set in "untaint_types" =cut @@ -81,7 +95,7 @@ sub untaint_type { =head2 cgi_update_errors -returns cgi update errors +Returns errors that ocurred during an operation. =cut @@ -96,16 +110,17 @@ Based on the same method in Class::DBI::FromCGI. Creates multiple objects from a cgi form. Errors are returned in cgi_update_errors -simple usage: $beer->create_from_cgi($r); -advanced usage: $beer->create_from_cgi($r[,$options ]); -old style: $beer->create_from_cgi($h[,$opts ]); - -A hashref of options can be passed. It can contain: - - params -- hashref of to use instead of $r->params, - required_cols -- list of fields that are required - ignore_cols -- list of fields to ignore +It can be called Maypole style passing the Maypole request object as the +first arg, or Class::DBI::FromCGI style passing the Untaint Handler ($h) +as the first arg. +A hashref of options can be passed as the second argument. Unlike +in the CDBI equivalent, you can *not* pass a list as the second argument. +Options can be : + params -- hashref of cgi data to use instead of $r->params, + required -- list of fields that are required + ignore -- list of fields to ignore + all -- list of all fields (defaults to $class->columns) =cut @@ -117,11 +132,11 @@ sub create_from_cgi { if ($r->isa('CGI::Untaint')) { # FromCGI interface compatibility - ($errors, $validated) = $self->validate_inputs($r,$opts); + ($validated, $errors) = $self->validate_inputs($r,$opts); } else { my $params = $opts->{params} || $r->params; $opts->{params} = $self->classify_form_inputs($params); - ($errors, $validated) = $self->validate_all($r, $opts); + ($validated, $errors) = $self->validate_all($r, $opts); } if (keys %$errors) { @@ -139,10 +154,9 @@ sub create_from_cgi { =head2 update_from_cgi -returns 1 or nothing if errors -TODO -- support $film->update_from_cgi($h => @columns_to_update); -usage?? - +Replicates the Class::DBI::FromCGI method of same name. It updates an object and +returns 1 upon success. It can take the same arguments as create_form_cgi. +If errors, it sets the cgi_update_errors. =cut @@ -179,11 +193,11 @@ sub update_from_cgi { } } $opts->{ignore} = \@ignore; - ($errors, $validated) = $self->validate_inputs($r,$opts); + ($validated, $errors) = $self->validate_inputs($r,$opts); } else { my $params = $opts->{params} || $r->params; $opts->{params} = $self->classify_form_inputs($params); - ($errors, $validated) = $self->validate_all($r, $opts); + ($validated, $errors) = $self->validate_all($r, $opts); #print "*** errors for validate all ****" . Dumper($errors); } @@ -202,10 +216,60 @@ sub update_from_cgi { return 1; } +=head2 add_to_from_cgi + +$obj->add_to_from_cgi($r[, $opts]); + +Like add_to_* for has_many relationships but will add nay objects it can +figure out from the data. It returns a list of objects it creates or nothing +on error. Call cgi_update_errors with the calling object to get errors. +Fatal errors are in the respective "FATAL" key. + +=cut + +sub add_to_from_cgi { + my ($self, $r, $opts) = @_; + $self->_croak( "add_to_from_cgi can only be called as an object method") + unless ref $self; + my ($errors, $validated, @created); + + + my $params = $opts->{params} || $r->params; + $opts->{params} = $self->classify_form_inputs($params); + ($validated, $errors) = $self->validate_all($r, $opts); + + + if (keys %$errors) { + $self->{_cgi_update_error} = $errors; + return; + } + + # Insert all the data + foreach my $hm (keys %$validated) { + my ($obj, $errs) = $self->_create_related($hm, $validated->{$hm}); + if (not $errs) { + push @created, $obj; + }else { + $errors->{$hm} = $errs; + } + } + + if (keys %$errors) { + $self->{_cgi_update_error} = $errors; + return; + } + + return @created; +} + + + + =head2 validate_all -Validates (untaints) a hash of possibly mixed table params. It returns hashrefs -of errors and validated data. +Validates (untaints) a hash of possibly mixed table data. +Returns validated and errors ($validated, $errors). +If no errors then undef in that spot. =cut @@ -231,10 +295,11 @@ sub validate_all { } $opts->{ignore} = $ignore; my $h = $Untainter->new($classified); - my ($errs, $validated) = $self->validate_inputs($h, $opts); + my ($validated, $errs) = $self->validate_inputs($h, $opts); # Validate all foreign input - + + #warn "Classified data is " . Dumper($classified); foreach my $field (keys %$classified) { if (ref $classified->{$field} eq "HASH") { my $data = $classified->{$field}; @@ -256,7 +321,7 @@ sub validate_all { push @$ignore, $_; } } - my ($ferrs, $valid) = $fclass->validate_all($r, + my ($valid, $ferrs) = $fclass->validate_all($r, {params => $data, updating => $updating, ignore => $ignore } ); $errs->{$field} = $ferrs if $ferrs; @@ -273,15 +338,22 @@ sub validate_all { } #warn "Validated inputs are " . Dumper($validated); undef $errs unless keys %$errs; - return ($errs, $validated); + return ($validated, $errs); } -=head2 validate_inputs - -$self->validate_inputs($h, $opts); - -=cut +# validate_inputs undocumented. It is not yet part of the public interface. +#=head2 validate_inputs +# +#$self->validate_inputs($h, $opts); +# +#This is the main validation method to validate inputs for a single class. +#Most of the time you use validate_all. +# +# Returns validated and errors. +# If no errors then undef in that slot. +# +#=cut sub validate_inputs { my ($self, $h, $opts) = @_; @@ -327,7 +399,7 @@ sub validate_inputs { } } undef $errors unless keys %$errors; - return ($errors, $fields); + return ($fields, $errors); } @@ -336,7 +408,8 @@ sub validate_inputs { ################## # Untaints and Creates objects from hashed params. -# Returns parent object and errors. +# Returns parent object and errors ($obj, $errors). +# If no errors, then undef in that slot. sub _do_create_all { my ($self, $validated) = @_; my $class = ref $self || $self; @@ -391,7 +464,7 @@ sub _do_create_all { $errors->{$accssr} = $errs if $errs; } - warn "Errors are " . Dumper($errors); + #warn "Errors are " . Dumper($errors); undef $errors unless keys %$errors; return ($me_obj, $errors); @@ -449,7 +522,8 @@ sub _do_update_all { ################### # Creates and automatically relates newly created object to calling object -# It returns related object and possibly errors +# Returns related object and errors ($obj, $errors). +# If no errors, then undef in that slot. sub _create_related { # self is object or class, accssr is accssr to relationship, params are @@ -465,7 +539,7 @@ sub _create_related { } my $rel_type = $rel_meta->{name}; my $fclass = $rel_meta->{foreign_class}; - warn " Dumper of meta is " . Dumper($rel_meta); + #warn " Dumper of meta is " . Dumper($rel_meta); my ($rel, $errs); @@ -478,7 +552,7 @@ sub _create_related { unless ($fkey) { die " Could not determine foreign key for $fclass"; } my %data = (%$params, $fkey => $self->id); %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} ); - warn "Data is " . Dumper(\%data); + #warn "Data is " . Dumper(\%data); ($rel, $errs) = $fclass->_do_create_all(\%data, $created); } else { @@ -558,7 +632,7 @@ Maypole Developers =head1 AUTHORS -Peter Speltz +Peter Speltz, Aaron Trevena =head1 AUTHORS EMERITUS @@ -578,7 +652,7 @@ Please direct all correspondence regarding this module to: =head1 COPYRIGHT AND LICENSE -Copyright 2003-2004 by Tony Bowden +Copyright 2003-2004 by Peter Speltz This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. -- 2.39.2