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;
# 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;
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 = $@)
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 {
}
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