]> git.decadent.org.uk Git - maypole.git/commitdiff
Finally, FromCGI seems functional and the documentation is accurate at
authorbiopete <biopete@invalid>
Wed, 12 Jul 2006 05:01:52 +0000 (05:01 +0000)
committerbiopete <biopete@invalid>
Wed, 12 Jul 2006 05:01:52 +0000 (05:01 +0000)
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

index 0d1f86a5f0d4a87b97358c8975b1e59a9a70de02..8c28c2c7f114ecb3298fe1ec0d5807287fe91294 100644 (file)
@@ -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.