package Maypole::Model::CDBI::FromCGI;
use strict;
+use warnings;
=head1 NAME
$obj = $obj->add_to_from_cgi($r);
$obj = $obj->add_to_from_cgi($r, { params => {...} } );
-
+
# This does not work like in CDBI::FromCGI and probably never will :
# $class->update_from_cgi($h, @columns);
=cut
-use warnings;
# The base base model class for apps
# provides good search and create functions
sub cgi_update_errors { %{ shift->{_cgi_update_error} || {} } }
-
-
=head2 create_from_cgi
Based on the same method in Class::DBI::FromCGI.
unless ref $self;
my ($errors, $validated, @created);
-
my $params = $opts->{params} || $r->params;
$opts->{params} = $self->classify_form_inputs($params);
($validated, $errors) = $self->validate_all($r, $opts);
my $updating = $opts->{updating};
# Base case - validate this classes data
- $opts->{all} ||= eval{ $r->config->{$self->table}{all_cols} } ||
- [$self->columns('All')];
- $opts->{required} ||= eval{ $r->config->{$self->table}{required_cols} } ||
- [];
- my $ignore = $opts->{ignore} || eval{ $r->config->{$self->table}{ignore_cols} }
- || [];
+ $opts->{all} ||= eval{ $r->config->{$self->table}{all_cols} } || [$self->columns('All')];
+ $opts->{required} ||= eval { $r->config->{$self->table}{required_cols} || $self->required_columns } || [];
+ my $ignore = $opts->{ignore} || eval{ $r->config->{$self->table}{ignore_cols} } || [];
push @$ignore, $self->primary_column->name if $updating;
# Ignore hashes of foreign inputs. This takes care of required has_a's
}
-# validate_inputs undocumented. It is not yet part of the public interface.
-#=head2 validate_inputs
-#
-#$self->validate_inputs($h, $opts);
-#
-#This is the main validation method to validate inputs for a single class.
-#Most of the time you use validate_all.
-#
-# Returns validated and errors.
-# If no errors then undef in that slot.
-#
-#=cut
+
+=head2 validate_inputs
+
+$self->validate_inputs($h, $opts);
+
+This is the main validation method to validate inputs for a single class.
+Most of the time you use validate_all.
+
+Returns validated and errors.
+
+If no errors then undef in that slot.
+
+Note: This method is currently experimental (in 2.11) and may be subject to change
+without notice.
+
+=cut
sub validate_inputs {
my ($self, $h, $opts) = @_;
# Required field error
if ($required{$field} and !ref($value) and $err =~ /^No input for/) {
- #($value eq '' or !defined $value))
$errors->{$field} = "You must supply '$field'"
- #unless ($updating and$self->field;
} elsif ($err) {
# 1: No inupt entered
foreach (keys %$validated) {
$related{$_}= delete $validated->{$_} if ref $validated->{$_} eq 'HASH';
}
- # Make has_own/a rel type objects and put id in parent's data hash
-# foreach $accssr (keys %related) {
-# my $rel_meta = $self->related_meta('r', $accssr);
-# $self->_croak("No relationship found for $accssr to $class.")
-# unless $rel_meta;
-# my $rel_type = $rel_meta->{name};
-# if ($rel_type =~ /(^has_own$|^has_a$)/) {
-# my $fclass= $rel_meta->{foreign_class};
-# my ($rel_obj, $errs) = $fclass->_do_create_all($related{$accssr});
-# # put id in parent's data hash
-# if (not keys %$errs) {
-# $validated->{$accssr} = $rel_obj->id;
-# } else {
-# $errors->{$accssr} = $errs;
-# }
-# delete $related{$accssr}; # done with this
-# }
-# }
# Make main object -- base case
#warn "\n*** validated data is " . Dumper($validated). "***\n";
my $me_obj = eval { $self->create($validated) };
if ($@) {
- warn "Just failed making a " . $self. " FATAL Error is $@"
- if (eval{$self->model_debug});
+ warn "Just failed making a " . $self. " FATAL Error is $@"
+ if (eval{$self->model_debug});
$errors->{FATAL} = $@;
return (undef, $errors);
}
-
+
if (eval{$self->model_debug}) {
if ($me_obj) {
warn "Just made a $self : $me_obj ( " . $me_obj->id . ")";
my ($rel_obj, $errs) =
$me_obj->_create_related($accssr, $related{$accssr});
$errors->{$accssr} = $errs if $errs;
-
+
}
#warn "Errors are " . Dumper($errors);
# If no errors, then undef in that slot.
sub _create_related {
- # self is object or class, accssr is accssr to relationship, params are
- # data for relobject, and created is the array ref to store objs we
- # create (optional).
- my ( $self, $accssr, $params, $created ) = @_;
- $self->_croak ("Can't make related object without a parent $self object")
- unless ref $self;
- $created ||= [];
- my $rel_meta = $self->related_meta('r',$accssr);
+ # self is object or class, accssr is accssr to relationship, params are
+ # data for relobject, and created is the array ref to store objs we
+ # create (optional).
+ my ( $self, $accssr, $params, $created ) = @_;
+ $self->_croak ("Can't make related object without a parent $self object")
+ unless ref $self;
+ $created ||= [];
+ my $rel_meta = $self->related_meta('r',$accssr);
if (!$rel_meta) {
- $self->_croak("No relationship for $accssr in " . ref($self));
- }
- my $rel_type = $rel_meta->{name};
- my $fclass = $rel_meta->{foreign_class};
- #warn " Dumper of meta is " . Dumper($rel_meta);
-
+ $self->_carp("[_create_related] No relationship for $accssr in " . ref($self));
+ return;
+ }
+ my $rel_type = $rel_meta->{name};
+ my $fclass = $rel_meta->{foreign_class};
+ #warn " Dumper of meta is " . Dumper($rel_meta);
- my ($rel, $errs);
- # Set up params for might_have, has_many, etc
- if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
+ my ($rel, $errs);
- # Foreign Key meta data not very standardized in CDBI
- my $fkey= $rel_meta->{args}{foreign_key} || $rel_meta->{foreign_column};
- unless ($fkey) { die " Could not determine foreign key for $fclass"; }
- my %data = (%$params, $fkey => $self->id);
- %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} );
- #warn "Data is " . Dumper(\%data);
- ($rel, $errs) = $fclass->_do_create_all(\%data, $created);
- }
- else {
- ($rel, $errs) = $fclass->_do_create_all($params, $created);
- unless ($errs) {
- $self->$accssr($rel->id);
- $self->update;
- }
+ # Set up params for might_have, has_many, etc
+ if ($rel_type ne 'has_own' and $rel_type ne 'has_a') {
+
+ # Foreign Key meta data not very standardized in CDBI
+ my $fkey= $rel_meta->{args}{foreign_key} || $rel_meta->{foreign_column};
+ unless ($fkey) { die " Could not determine foreign key for $fclass"; }
+ my %data = (%$params, $fkey => $self->id);
+ %data = ( %data, %{$rel_meta->{args}->{constraint} || {}} );
+ #warn "Data is " . Dumper(\%data);
+ ($rel, $errs) = $fclass->_do_create_all(\%data, $created);
+ }
+ else {
+ ($rel, $errs) = $fclass->_do_create_all($params, $created);
+ unless ($errs) {
+ $self->$accssr($rel->id);
+ $self->update;
}
- return ($rel, $errs);
+ }
+ return ($rel, $errs);
}
projects / maypole.git / blobdiff