package Maypole::Model::CDBI;
use base qw(Maypole::Model::Base Class::DBI);
use Class::DBI::AsForm;
+# use Maypole::Form::CDBI;
+use CGI::Untaint;
+# use Maypole::Form;
+
use Class::DBI::FromCGI;
use Class::DBI::Loader;
use Class::DBI::AbstractSearch;
use Class::DBI::Pager;
use Lingua::EN::Inflect::Number qw(to_PL);
-use CGI::Untaint;
+
use strict;
=head1 NAME
}
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} || [];
+
+ ($obj, my $fatal, my $creating) = $self->_do_update_or_create($r, $obj, $required_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) = @_;
+
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} ) };
$fatal = $@;
}
- else {
- eval {
- $obj =
- $self->create_from_cgi( $h =>
- { required => $r->{config}{ $r->{table} }{required_cols} || [], }
- );
+ else
+ {
+ eval {
+ $obj = $self->create_from_cgi( $h => {required => $required_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 ) = @_;
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 {