another change to object stringification in selects in AsForm

git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@541 48953598-375a-da11-a14b-00016c27c3ee

diff --git a/Changes b/Changes
index cfc5d205a01bedc32442e5307a3abad9509d6d1d..96eac8dfc11087b6847e1a9fff33a0d7e248ebd5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -15,6 +15,8 @@ For information about current developments and future releases, see:
    new warn method in maypole/request class/object, over-ridden by Apache::MVC, etc or own driver
    AsForm fixes to stringification _to_select 
    new build_form_elements attribute for Maypole request, set it to 0 to avoid building cgi form if you don't need it
+   made DFV and FromCGI warn instead of die on unexpected cgi params
+   added CGI params to TT error template
 
 2.11 Mon 31 July 2006
 

diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index b8e4e91a483191f424d6d6ac203f0bdb63351196..c072dc8d7112e1433e1fd5ef3c062b598947842e 100644 (file)
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -1173,11 +1173,13 @@ objects stringify method specified in $args->{stringify} as the content. Otherwi
 sub _options_from_objects {
   my ($self, $items, $args) = @_;
   my $selected = $args->{selected} || {};
-  my $stringify = $args->{stringify};
 
   my @res;
   for my $object (@$items) {
-    $stringify ||= $object->stringify_column if ($object->can('stringify_column'));
+    my $stringify = $args->{stringify};
+    if ($object->can('stringify_column') ) {
+      $stringify ||= $object->stringify_column if ($object->can($object->stringify_column));
+    }
     my $id = $object->id;
     my $opt = HTML::Element->new("option", value => $id);
     $id =~ s/^0*//;            # leading zeros no good in hash key

diff --git a/lib/Maypole/Model/CDBI/DFV.pm b/lib/Maypole/Model/CDBI/DFV.pm
index eb2bf20668834329b18f692042fa03ae13c931f5..5a74f71848433e00038c55390045806cbffd7702 100644 (file)
--- a/lib/Maypole/Model/CDBI/DFV.pm
+++ b/lib/Maypole/Model/CDBI/DFV.pm
@@ -190,7 +190,8 @@ sub _do_update {
       # 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));
+       $class->_carp("No relationship for $accssr in " . ref($class));
+       next;
       }
 
       my $rel_type  = $rel_meta->{name};
@@ -256,7 +257,8 @@ sub _create_related {
   my $created = [];
   my $rel_meta = $self->related_meta('r',$accssr);
   if (!$rel_meta) {
-    $self->_croak("No relationship for $accssr in " . ref($self));
+    $self->_carp("No relationship for $accssr in " . ref($self));
+    return;
   }
 
   my $rel_type  = $rel_meta->{name};

diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm
index e01fb9e89312a33fbb14f5abb3567b591caf847c..df0b9ffa63e4c666754f666f5c7a146f37338f4d 100644 (file)
--- a/lib/Maypole/Model/CDBI/FromCGI.pm
+++ b/lib/Maypole/Model/CDBI/FromCGI.pm
@@ -417,35 +417,17 @@ sub _do_create_all {
   foreach (keys %$validated) {
     $related{$_}= delete $validated->{$_} if ref $validated->{$_} eq 'HASH';
   }
-  # Make has_own/a rel type objects and put id in parent's data hash 
-#  foreach $accssr (keys %related) {
-#    my $rel_meta = $self->related_meta('r', $accssr); 
-#    $self->_croak("No relationship found for $accssr to $class.")
-#      unless $rel_meta;
-#    my $rel_type   = $rel_meta->{name};
-#    if ($rel_type =~ /(^has_own$|^has_a$)/) {
-#      my $fclass= $rel_meta->{foreign_class};
-#      my ($rel_obj, $errs) = $fclass->_do_create_all($related{$accssr});
-#      # put id in parent's data hash 
-#      if (not keys %$errs) {
-#      $validated->{$accssr} = $rel_obj->id;
-#      } else {
-#      $errors->{$accssr} = $errs;
-#      }
-#      delete $related{$accssr}; # done with this 
-#    }
-#  }
 
   # Make main object -- base case
   #warn "\n*** validated data is " . Dumper($validated). "***\n";
   my $me_obj  = eval { $self->create($validated) };
   if ($@) { 
-       warn "Just failed making a " . $self. " FATAL Error is $@"
-               if (eval{$self->model_debug});  
+    warn "Just failed making a " . $self. " FATAL Error is $@"
+      if (eval{$self->model_debug});  
     $errors->{FATAL} = $@; 
     return (undef, $errors);
   }
-       
+
   if (eval{$self->model_debug}) {
     if ($me_obj) {
       warn "Just made a $self : $me_obj ( " . $me_obj->id . ")";
@@ -459,7 +441,7 @@ sub _do_create_all {
     my ($rel_obj, $errs) = 
       $me_obj->_create_related($accssr, $related{$accssr});
     $errors->{$accssr} = $errs if $errs;
-       
+
   }
   #warn "Errors are " . Dumper($errors);
 
@@ -523,43 +505,44 @@ sub _do_update_all {
 # If no errors, then undef in that slot.
 
 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 we 
-       # create (optional).
-       my ( $self, $accssr, $params, $created )  = @_;
-       $self->_croak ("Can't make related object without a parent $self object") 
-               unless ref $self;
-       $created      ||= [];
-       my  $rel_meta = $self->related_meta('r',$accssr);
+    # self is object or class, accssr is accssr to relationship, params are 
+    # data for relobject, and created is the array ref to store objs we 
+    # create (optional).
+    my ( $self, $accssr, $params, $created )  = @_;
+    $self->_croak ("Can't make related object without a parent $self object") 
+       unless ref $self;
+    $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};
-       #warn " Dumper of meta is " . Dumper($rel_meta);
-       
+       $self->_carp("No relationship for $accssr in " . ref($self));
+       return;
+    }
+    my $rel_type  = $rel_meta->{name};
+    my $fclass    = $rel_meta->{foreign_class};
+    #warn " Dumper of meta is " . Dumper($rel_meta);
 
-       my ($rel, $errs); 
 
-       # Set up params for might_have, has_many, etc
-       if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
+    my ($rel, $errs); 
 
-               # 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} || {}} );
-               #warn "Data is " . Dumper(\%data);
-           ($rel, $errs) =  $fclass->_do_create_all(\%data, $created);
-       }
-       else { 
-           ($rel, $errs) =  $fclass->_do_create_all($params, $created);
-               unless ($errs) {
-                       $self->$accssr($rel->id);
-                       $self->update;
-               }
+    # 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} || {}} );
+       #warn "Data is " . Dumper(\%data);
+       ($rel, $errs) =  $fclass->_do_create_all(\%data, $created);
+    }
+    else { 
+       ($rel, $errs) =  $fclass->_do_create_all($params, $created);
+       unless ($errs) {
+           $self->$accssr($rel->id);
+           $self->update;
        }
-       return ($rel, $errs);
+    }
+    return ($rel, $errs);
 }
 
 

diff --git a/lib/Maypole/View/TT.pm b/lib/Maypole/View/TT.pm
index 3ab23be31da7c14740d41ad80e666bddf376c180..7c30777382d5bd151d3e5c2a5b64bc9e2c1e9364 100644 (file)
--- a/lib/Maypole/View/TT.pm
+++ b/lib/Maypole/View/TT.pm
@@ -423,6 +423,11 @@ the path "[% request.path %]". The error text returned was:
     <tr> <td class="lhs" width="35%"> <b>[% attribute %]</b> </td> <td class="rhs" width="65%"> [%
     request.$attribute.list.join(" , ") %] </td></tr>
     [% END %]
+    <tr><td colspan="2"></tr>
+    <tr><td class="lhs" colspan="2"><b>CGI Parameters</b> </td></tr>
+    [% FOREACH param IN request.params %]
+    <tr> <td class="lhs" width="35%">[% param.key %]</td> <td class="rhs" width="65%"> [% param.value %] </td></tr>
+    [% END %]
 </table>
 
 <h2> Website / Template Paths </h2>

diff --git a/lib/Maypole/templates/factory/edit b/lib/Maypole/templates/factory/edit
index 3b0aca635d6b0a569f0ed32601a0fedbdca8e072..bac8c6dbec42422138975b059dde5fdb0ce60eb4 100644 (file)
--- a/lib/Maypole/templates/factory/edit
+++ b/lib/Maypole/templates/factory/edit
@@ -23,12 +23,12 @@ form similar to L<addnew> but with the current values filled in.
 <legend>Edit [% object.name %]</legend>
    [% FOR col = classmetadata.columns;
     NEXT IF col == "id" OR col == classmetadata.table _ "_id";
-    '<label><span class="field">';
-    classmetadata.colnames.$col; ":</span>";
-    object.to_field(col).as_XML;
-    "</label>";
-    IF errors.$col; 
+    SET col_label = classmetadata.colnames.$col; %]
+    <label><span class="field"> [% col_label %] </span> [% object.to_field(col).as_XML %]</label>
+    [% IF errors.$col; 
        '<span class="error">'; errors.$col;'</span>';
+    ELSIF  errors.$col_label; 
+       '<span class="error">'; errors.$col_label;'</span>';
     END;
     END %]
     <input type="submit" name="edit" value="edit"/>