X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI.pm;h=1442d0eccfa7a216d6e213c560ae1a8f2eec36c1;hb=a02686080acb66fce170e9657e110761b09e62a2;hp=6ae19f53fa12db0ee355dcebb6425e26b30fe256;hpb=9248ebe461d183756053e56e7b1941f5c682e344;p=maypole.git diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 6ae19f5..1442d0e 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -113,8 +113,9 @@ sub do_edit : Exported 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); + ($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; @@ -140,7 +141,7 @@ sub do_edit : Exported # reported by Mp::P::Trace sub _do_update_or_create { - my ($self, $r, $obj, $required_cols) = @_; + my ($self, $r, $obj, $required_cols, $ignored_cols) = @_; my $fatal; my $creating = 0; @@ -150,13 +151,19 @@ sub _do_update_or_create if ($obj) { # We have something to edit - eval { $obj->update_from_cgi( $h => {required => $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 => $required_cols} ) + eval { + $obj = $self->create_from_cgi( $h => { + required => $required_cols, + ignore => $ignored_cols, + } ) }; if ($fatal = $@) @@ -168,14 +175,22 @@ sub _do_update_or_create 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 { @@ -197,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