X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=1442d0eccfa7a216d6e213c560ae1a8f2eec36c1;hb=a02686080acb66fce170e9657e110761b09e62a2;hp=c80a2902e0ad69cd74bb507a4abd56d43dfbb25a;hpb=3323461600041b1b4f420cb8487637067bc2a5fc;p=maypole.git

diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm
index c80a290..1442d0e 100644
--- a/lib/Maypole/Model/CDBI.pm
+++ b/lib/Maypole/Model/CDBI.pm
@@ -85,71 +85,112 @@ sub related {
 }
 
 sub related_class {
-    my ( $self, $r, $accessor ) = @_;
-
-    my $related = $self->meta_info( has_many => $accessor ) ||
-                  $self->meta_info( has_a    => $accessor ) ||
-                  return;
+     my ( $self, $r, $accessor ) = @_;
+     my $meta = $self->meta_info;
+     my @rels = keys %$meta;
+     my $related;
+     foreach (@rels) {
+         $related = $meta->{$_}{$accessor};
+         last if $related;
+     }
+     return unless $related;
+
+     my $mapping = $related->{args}->{mapping};
+     if ( $mapping and @$mapping ) {
+       return $related->{foreign_class}->meta_info('has_a')->{$$mapping[0]}->{foreign_class};
+     }
+     else {
+         return $related->{foreign_class};
+     }
+ }
+
+
+sub do_edit : Exported 
+{
+    my ($self, $r, $obj) = @_;
+
+    my $config   = $r->config;
+    my $table    = $r->table;
+    
+    my $required_cols = $config->{$table}->{required_cols} || [];
+    my $ignored_cols = $r->{config}{ $r->{table} }{ignore_cols};
+    
+    ($obj, my $fatal, my $creating) = $self->_do_update_or_create($r, $obj, $required_cols, $ignored_cols);
+    
+    # handle errors, if none, proceed to view the newly created/updated object
+    my %errors = $fatal ? (FATAL => $fatal) : $obj->cgi_update_errors;
+    
+    if (%errors) 
+    {
+        # Set it up as it was:
+        $r->template_args->{cgi_params} = $r->params;
+        $r->template_args->{errors}     = \%errors;
 
-    my $mapping = $related->{args}->{mapping} || [];
-    if ( @$mapping ) {
-        return $related->{foreign_class}->meta_info('has_a')->{ $$mapping[0] }
-          ->{foreign_class};
+        undef $obj if $creating;
+        $r->template("edit");
     }
-    else {
-        return $related->{foreign_class};
+    else 
+    {
+        $r->template("view");
     }
+    
+    $r->objects( $obj ? [$obj] : []);
 }
 
-sub do_edit : Exported {
-    my ( $self, $r ) = @_;
-    my $h        = CGI::Untaint->new( %{ $r->{params} } );
-    my $creating = 0;
-    my ($obj) = @{ $r->objects || [] };
+# drb - I've (probably temporarily) split this out from do_edit, so it's 
+# reported by Mp::P::Trace
+sub _do_update_or_create
+{
+    my ($self, $r, $obj, $required_cols, $ignored_cols) = @_;
+    
     my $fatal;
-    if ($obj) {
+    my $creating = 0;
+    my $h = CGI::Untaint->new( %{$r->params} );
+    
+    # update or create
+    if ($obj) 
+    {
         # We have something to edit
-        eval {
-            $obj->update_from_cgi( $h =>
-                { required => $r->{config}{ $r->{table} }{required_cols} || [], }
-            );
-        };
+        eval { $obj->update_from_cgi( $h => {
+					     required => $required_cols,
+					     ignore => $ignored_cols,
+					    } ) };
         $fatal = $@;
     }
-    else {
+    else
+    {
         eval {
-            $obj =
-                $self->create_from_cgi( $h =>
-                    { required => $r->{config}{ $r->{table} }{required_cols} || [], }
-            );
+            $obj = $self->create_from_cgi( $h => {
+						  required => $required_cols,
+						  ignore => $ignored_cols,
+						 } )
         };
-        if ($fatal = $@) {
+        
+        if ($fatal = $@) 
+        {
             warn "$fatal" if $r->debug;
         }
         $creating++;
     }
-    if ( my %errors = $fatal ? (FATAL => $fatal) : $obj->cgi_update_errors ) {
-
-        # Set it up as it was:
-        $r->{template_args}{cgi_params} = $r->{params};
-        $r->{template_args}{errors}     = \%errors;
-
-        undef $obj if $creating;
-        $r->template("edit");
-    }
-    else {
-        $r->{template} = "view";
-    }
-    $r->objects( $obj ? [$obj] : []);
+    
+    return $obj, $fatal, $creating;
 }
 
 sub delete : Exported {
-    return shift->SUPER::delete(@_) if caller ne "Maypole::Model::Base";
-    my ( $self, $r ) = @_;
-    $_->SUPER::delete for @{ $r->objects || [] };
-    $r->objects( [ $self->retrieve_all ] );
-    $r->{template} = "list";
-    $self->list($r);
+  my $self = shift;
+  my ($sub) = (caller(1))[3];
+  $sub =~ /^(.+)::([^:]+)$/;
+  # So subclasses can still send search down ...
+  return ($1 ne "Maypole::Model::Base" && $2 ne "delete") ?
+    $self->SUPER::search(@_) : $self->do_delete(@_);
+}
+
+sub do_delete {
+  my ( $self, $r ) = @_;
+  $_->SUPER::delete for @{ $r->objects || [] };
+  $r->objects( [ $self->retrieve_all ] );
+  $r->{template} = "list";
+  $self->list($r);
 }
 
 sub stringify_column {
@@ -171,9 +212,15 @@ sub adopt {
 }
 
 sub search : Exported {
-    return shift->SUPER::search(@_) if caller ne "Maypole::Model::Base";
+  my $self = shift;
+  my ($sub) = (caller(1))[3];
+  $sub =~ /^(.+)::([^:]+)$/;
+  # So subclasses can still send search down ...
+  return ($1 ne "Maypole::Model::Base" && $2 ne "search") ?
+    $self->SUPER::search(@_) : $self->do_search(@_);
+}
 
-    # A real CDBI search.
+sub do_search : Exported {
     my ( $self, $r ) = @_;
     my %fields = map { $_ => 1 } $self->columns;
     my $oper   = "like";                                # For now
@@ -252,7 +299,7 @@ sub setup_database {
 
 sub class_of {
     my ( $self, $r, $table ) = @_;
-    return $r->config->loader->_table2class($table);
+    return $r->config->loader->_table2class($table); # why not find_class ?
 }
 
 sub fetch_objects {