use base qw(Maypole::Model::Base Class::DBI);
use Maypole::Model::CDBI::AsForm;
+
+use Maypole::Model::CDBI::FromCGI;
use CGI::Untaint::Maypole;
+our $Untainter = 'CGI::Untaint::Maypole';
+
+# or if you like bugs
-use Class::DBI::FromCGI;
+#use Class::DBI::FromCGI;
+#use CGI::Untaint;
+#our $Untainter = 'CGI::Untaint';
+
+use Class::DBI::Plugin::Type;
use Class::DBI::Loader;
use Class::DBI::AbstractSearch;
use Class::DBI::Plugin::RetrieveAll;
use Lingua::EN::Inflect::Number qw(to_PL);
use attributes ();
+use Data::Dumper;
+
###############################################################################
# Helper methods
my $config = $r->config;
my $table = $r->table;
- # handle cancel button hits
+ # handle cancel button hit
if ( $r->{params}->{cancel} ) {
$r->template("list");
$r->objects( [$self->retrieve_all] );
if (%errors) {
# Set it up as it was:
$r->template_args->{cgi_params} = $r->params;
- $r->template_args->{errors} = \%errors;
+
+ #
+ # replace user unfriendly error messages with something nicer
+
+ foreach (@{$config->{$table}->{required_cols}}) {
+ next unless ($errors{$_});
+ my $key = $_;
+ s/_/ /g;
+ $r->template_args->{errors}{ucfirst($_)} = 'This field is required, please provide a valid value';
+ $r->template_args->{errors}{$key} = 'This field is required, please provide a valid value';
+ delete $errors{$key};
+ }
+
+ foreach (keys %errors) {
+ my $key = $_;
+ s/_/ /g;
+ $r->template_args->{errors}{ucfirst($_)} = 'Please provide a valid value for this field';
+ $r->template_args->{errors}{$key} = 'Please provide a valid value for this field';
+ }
undef $obj if $creating;
+
+ die "do_update failed with error : $fatal" if ($fatal);
$r->template("edit");
} else {
$r->template("view");
}
+
+
$r->objects( $obj ? [$obj] : []);
}
my $fatal;
my $creating = 0;
- my $h = CGI::Untaint::Maypole->new( %{$r->params} );
+
+ my $h = $Untainter->new( %{$r->params} );
# update or create
if ($obj) {
+ # 1: Required fields for update are different than create. Its only required
+ # if it is in the parameters
+
+# my @real_required = ();
+# my %required = map { $_ => 1 } @$required_cols;
+# foreach (keys %{$r->params}) {
+# push @real_required, $_ if $required{$_};
+# }
+
# We have something to edit
eval { $obj->update_from_cgi( $h => {
required => $required_cols,
ignore => $ignored_cols,
- } ) };
+ } );
+ $obj->update(); # pos fix for bug 17132 'autoupdate required by do_edit'
+ };
$fatal = $@;
} else {
- eval {
- $obj = $self->create_from_cgi( $h => {
+ eval {
+ $obj = $self->create_from_cgi( $h => {
required => $required_cols,
ignore => $ignored_cols,
- } )
- };
-
- if ($fatal = $@) {
- warn "$fatal" if $r->debug;
- }
- $creating++;
+ } );
+ };
+ $fatal = $@;
+ $creating++;
}
return $obj, $fatal, $creating;
}
+=head2 delete
+
+Deprecated method that calls do_delete or a given classes delete method, please
+use do_delete instead
+
=head2 do_delete
Unsuprisingly, this command causes a database record to be forever lost.
sub delete : Exported {
my $self = shift;
my ($sub) = (caller(1))[3];
+ # So subclasses can still send delete down ...
$sub =~ /^(.+)::([^:]+)$/;
- # So subclasses can still send search down ...
- return ($1 ne "Maypole::Model::Base" && $2 ne "delete") ?
- $self->SUPER::search(@_) : $self->do_delete(@_);
+ if ($1 ne "Maypole::Model::Base" && $2 ne "delete") {
+ $self->SUPER::delete(@_);
+ } else {
+ warn "Maypole::Model::CDBI delete method is deprecated\n";
+ $self->do_delete(@_);
+ }
}
sub do_delete {
my ( $self, $r ) = @_;
+ # FIXME: handle fatal error with exception
$_->SUPER::delete for @{ $r->objects || [] };
+# $self->dbi_commit;
$r->objects( [ $self->retrieve_all ] );
$r->{template} = "list";
$self->list($r);
}
+=head2 search
+
+Deprecated searching method - use do_search instead.
=head2 do_search
);
$config->{classes} = [ $config->{loader}->classes ];
$config->{tables} = [ $config->{loader}->tables ];
- warn( 'Loaded tables: ' . join ',', @{ $config->{tables} } )
+
+ my @table_class = map { $_ . " => " . $config->{loader}->_table2class($_) } @{ $config->{tables} };
+ warn( 'Loaded tables to classes: ' . join ', ', @table_class )
if $namespace->debug;
}
+=head2 class_of
+
+ returns class for given table
+
+=cut
+
sub class_of {
my ( $self, $r, $table ) = @_;
return $r->config->loader->_table2class($table); # why not find_class ?
}
+=head2 fetch_objects
+
+Returns 1 or more objects of the given class when provided with the request
+
+=cut
+
sub fetch_objects {
my ($class, $r)=@_;
my @pcs = $class->primary_columns;