# pjs -- Added new methods to @EXPORT
our @EXPORT =
qw(
- to_cgi to_field make_element_foreign search_inputs unselect_element
+ to_cgi to_field foreign_input_delimiter search_inputs unselect_element
_field_from_how _field_from_relationship _field_from_column
_to_textarea _to_textfield _to_select _select_guts
_to_foreign_inputs _to_enum_select _to_bool_select
my ($class, @columns) = @_; # pjs -- added columns arg
my $args = {};
if (not @columns) {
- @columns = $class->columns;
+ @columns = $class->columns;
+ # Eventually after stabalization, we could add display_columns
+ #keys map { $_ => 1 } ($class->display_columns, $class->columns);
}
else {
if ( ref $columns[-1] eq 'HASH' ) { $args = pop @columns; }
=head2 to_field($field [, $how][, $args])
This maps an individual column to a form element. The C<how> argument
-can be used to force the field type into any you want. It tells AsForm how
-to make the input ie-- forces it to use the method "_to_$how".
+can be used to force the field type into any you want. All that you need
+is a method named "_to_$how" in your class. Your class inherits many from
+AsForm already. Override them at will.
+
If C<how> is specified but the class cannot call the method it maps to,
then AsForm will issue a warning and the default input will be made.
You can write your own "_to_$how" methods and AsForm comes with many.
_rename_foreign_input($html_el_or_hash_of_them); # changes made by reference
Recursively renames the foreign inputs made by _to_foreign_inputs so they
-can be processed generically. The format is "accessor__AsForeign_colname".
+can be processed generically. It uses foreign_input_delimiter.
-So if an Employee is a Person who has_own Address and you call
+So if an Employee is a Person who has_many Addresses and you call and the
+method 'foreign_input_delimiter' returns '__AF__' then
- Employee->to_field("person")
+ Employee->to_field("person");
-then you will get inputs for the Person as well as their Address (by default,
+will get inputs for the Person as well as their Address (by default,
override _field_from_relationship to change logic) named like this:
- person__AsForeign__address__AsForeign__street
- person__AsForeign__address__AsForeign__city
- person__AsForeign__address__AsForeign__state
- person__AsForeign__address__AsForeign__zip
+ person__AF__address__AF__street
+ person__AF__address__AF__city
+ person__AF__address__AF__state
+ person__AF__address__AF__zip
And the processor would know to create this address, put the address id in
-person->address data slot, create the person and put the person id in the employee->person data slot and then create the employee with that data.
-
-Overriede make_element_foreign to change how you want a foreign param labeled.
-
-=head2 make_element_foreign
-
- $class->make_element_foreign($accessor, $element);
-
-Makes an HTML::Element type object foreign elemen representing the
-class's accessor. (IE this in an input element for $class->accessor :) )
+person->{address} data slot, insert the person and put the person id in the employee->{person} data slot and then insert the employee with that data.
=cut
-sub make_element_foreign {
- my ($self, $accssr, $element) = @_;
- $element->attr( name => $accssr . "__AsForeign__" . $element->attr('name'));
-}
-
-
-
sub _rename_foreign_input {
my ($self, $accssr, $element) = @_;
+ my $del = $self->foreign_input_delimiter;
+
if ( ref $element ne 'HASH' ) {
- # my $new_name = $accssr . "__AsForeign__" . $input->attr('name');
- $self->make_element_foreign($accssr, $element);
+ # my $new_name = $accssr . "__AF__" . $input->attr('name');
+ $element->attr( name => $accssr . $del . $element->attr('name'));
}
else {
$self->_rename_foreign_input($accssr, $element->{$_})
foreach (keys %$element);
}
}
+
+=head2 foreign_input_delimiter
+
+This tells AsForm what to use to delmit forieign_input names with. The name has the form -- $foreign_accessor. $DELIMITER . $foreign_column
+
+=cut
+
+sub foreign_input_delimiter { '__AF__' };
+
=head2 _box($value)
This functions computes the dimensions of a textarea based on the value
=cut
-our ($min_rows, $max_rows, $min_cols, $max_cols) = (2 => 50, 20 => 100);
sub _box
{
+
+ my ($min_rows, $max_rows, $min_cols, $max_cols) = (2 => 50, 20 => 100);
my $text = shift;
if ($text) {
my @rows = split /^/, $text;
our $Untainter = 'CGI::Untaint::Maypole';
our @EXPORT = qw/update_from_cgi create_from_cgi untaint_columns
- cgi_update_errors untaint_type _validate validate_all _do_update_all
- _do_create_all classify_form_inputs/;
+ cgi_update_errors untaint_type validate_inputs validate_all _do_update_all
+ _do_create_all _create_related classify_form_inputs/;
Creates multiple objects from a cgi form.
Errors are returned in cgi_update_errors
-simple usage: $beer->create_from_cgi($r);
+simple usage: $beer->create_from_cgi($r);
+advanced usage: $beer->create_from_cgi($r[,$options ]);
+old style: $beer->create_from_cgi($h[,$opts ]);
+
+A hashref of options can be passed. It can contain:
+
+ params -- hashref of to use instead of $r->params,
+ required_cols -- list of fields that are required
+ ignore_cols -- list of fields to ignore
-The last arg is flag to say whether to classify inputs or not.
-TODO : make 100% backward compatible
=cut
sub create_from_cgi {
- my ($self, $r, $params, $no_classify) = @_;
+ my ($self, $r, $opts) = @_;
$self->_croak( "create_from_cgi can only be called as a class method")
if ref $self;
-
my ($errors, $validated);
- # FromCGI interface compatibility
- # params are ($h, $wanted)
- if ($r->isa('CGI::Untaint')) {
- ($errors, $validated) = $self->_validate($r,$params);
+
+
+ if ($r->isa('CGI::Untaint')) { # FromCGI interface compatibility
+ ($errors, $validated) = $self->validate_inputs($r,$opts);
} else {
- $params ||= $r->params;
- my $classified = $no_classify ? {%$params}:$self->classify_form_inputs($params);
- ($errors, $validated) = $self->validate_all($r, $classified);
+ my $params = $opts->{params} || $r->params;
+ $opts->{params} = $self->classify_form_inputs($params);
+ ($errors, $validated) = $self->validate_all($r, $opts);
}
if (keys %$errors) {
# Insert all the data
my ($obj, $err ) = $self->_do_create_all($validated);
if ($err) {
- return bless { _cgi_update_error => $err }, $obj ;
+ return bless { _cgi_update_error => $err }, $self;
}
return $obj;
}
=head2 update_from_cgi
returns 1 or nothing if errors
+TODO -- support $film->update_from_cgi($h => @columns_to_update);
+usage??
+
=cut
sub update_from_cgi {
- my ($self, $r, $params, $no_classify) = @_;
+ my ($self, $r, $opts) = @_;
$self->_croak( "update_from_cgi can only be called as an object method") unless ref $self;
- my ($errors, $validated, $wanted);
+ my ($errors, $validated);
$self->{_cgi_update_error} = {};
+ $opts->{updating} = 1;
- # FromCGI interface compatibility params are ($h, $wanted)
+ # FromCGI interface compatibility
if ($r->isa('CGI::Untaint')) {
- # REHASH the $wanted for updating:
+ # REHASH the $opts for updating:
# 1: we ignore any fields we dont have parmeter for. (safe ?)
# 2: we dont want to update fields unless they change
- my ($h, $wanted) = ($r, $params);
- my @ignore = @{$wanted->{ignore} || []};
+ my @ignore = @{$opts->{ignore} || []};
push @ignore, $self->primary_column->name;
- my $raw = $h->raw_data;
+ my $raw = $r->raw_data;
#print "*** raw data ****" . Dumper($raw);
foreach my $field ($self->columns) {
#print "*** field is $field ***\n";
- if (not defined $raw->{$field}) {
- push @ignore, $field->name;
- #print "*** ignoring $field because it is not present ***\n";
- next;
- }
- # stupid inflation , cant get at raw db value easy, must call
- # deflate ***FIXME****
- my $cur_val = ref $self->$field ? $self->$field->id : $self->$field;
- if ($raw->{$field} eq $cur_val) {
- #print "*** ignoring $field because unchanged ***\n";
- push @ignore, $field->name;
- }
+ if (not defined $raw->{$field}) {
+ push @ignore, $field->name;
+ #print "*** ignoring $field because it is not present ***\n";
+ next;
+ }
+ # stupid inflation , cant get at raw db value easy, must call
+ # deflate ***FIXME****
+ my $cur_val = ref $self->$field ? $self->$field->id : $self->$field;
+ if ($raw->{$field} eq $cur_val) {
+ #print "*** ignoring $field because unchanged ***\n";
+ push @ignore, "$field";
+ }
}
-
- $wanted->{ignore} = \@ignore;
- #print "*** wanted ****" . Dumper($wanted);
- ($errors, $validated) = $self->_validate($h,$wanted,1);
- #print "*** validated data ****" . Dumper($validated);
- #print "*** errors ****" . Dumper($errors);
+ $opts->{ignore} = \@ignore;
+ ($errors, $validated) = $self->validate_inputs($r,$opts);
} else {
- $params ||= $r->params;
- my $classified = $no_classify ? {%$params}:$self->classify_form_inputs($params);
- ($errors, $validated) = $self->validate_all($r, $classified,1);
+ my $params = $opts->{params} || $r->params;
+ $opts->{params} = $self->classify_form_inputs($params);
+ ($errors, $validated) = $self->validate_all($r, $opts);
#print "*** errors for validate all ****" . Dumper($errors);
}
=cut
sub validate_all {
- my ($self, $r, $classified, $updating) = @_;
+ my ($self, $r, $opts) = @_;
+ my $class = ref $self || $self;
+ my $classified = $opts->{params};
+ my $updating = $opts->{updating};
# Base case - validate this classes data
- my $all = eval{ $r->config->{$self->table}{all_cols} } ||
+ $opts->{all} ||= eval{ $r->config->{$self->table}{all_cols} } ||
[$self->columns('All')];
- my $req = eval{ $r->config->{$self->table}{required_cols} } ||
- [];
- my $ignore = eval{ $r->config->{$self->table}{ignore_cols} } ||
- [];
+ $opts->{required} ||= eval{ $r->config->{$self->table}{required_cols} } ||
+ [];
+ my $ignore = $opts->{ignore} || eval{ $r->config->{$self->table}{ignore_cols} }
+ || [];
push @$ignore, $self->primary_column->name if $updating;
- # ignore hashes of foreign inputs
+
+ # Ignore hashes of foreign inputs. This takes care of required has_a's
+ # for main object that we have foreign inputs for.
foreach (keys %$classified) {
push @$ignore, $_ if ref $classified->{$_} eq 'HASH';
}
+ $opts->{ignore} = $ignore;
my $h = $Untainter->new($classified);
- my ($errs, $validated) = $self->_validate(
- $h, {all => $all, required => $req, ignore => $ignore},$updating
- );
+ my ($errs, $validated) = $self->validate_inputs($h, $opts);
- #warn "Validated dump is " . Dumper($validated);
- #warn "classified dump is " . Dumper($classified);
# Validate all foreign input
+
foreach my $field (keys %$classified) {
if (ref $classified->{$field} eq "HASH") {
my $data = $classified->{$field};
- # warn "Dump of fdata for $field: " . Dumper($data) if $r->debug;
+ my $ignore = [];
my @usr_entered_vals = ();
- my %required = map { $_ => 1 }
- @{$r->config->{$self->table}{required_cols}};
foreach ( values %$data ) {
- push @usr_entered_vals, $_ if $_ ne '';
+ push @usr_entered_vals, $_ if $_ ne '';
}
# filled in values
# IF we have some inputs for the related
if ( @usr_entered_vals ) {
- # warn "user entered vals . " . Dumper(\@usr_entered_vals) if $r->debug;
- my ($ferrs, $valid) = $self->related_class($r, $field)->validate_all($r, $classified->{$field}, $updating );
- $errs->{$field} = $ferrs if $ferrs;
- $validated->{$field} = $valid;
+ # We need to ignore us if we are a required has_a in this foreign class
+ my $rel_meta = $self->related_meta($r, $field);
+ my $fclass = $rel_meta->{foreign_class};
+ my $fmeta = $fclass->meta_info('has_a');
+ for (keys %$fmeta) {
+ if ($fmeta->{$_}{foreign_class} eq $class) {
+ push @$ignore, $_;
+ }
+ }
+ my ($ferrs, $valid) = $fclass->validate_all($r,
+ {params => $data, updating => $updating, ignore => $ignore } );
+
+ $errs->{$field} = $ferrs if $ferrs;
+ $validated->{$field} = $valid;
+
} else {
- # Check its not requeired
- if ($required{$field}) {
- $errs->{$field}{FATAL} = "This is required. Please enter the required fields in this section."
- }
- }
- }
+ # Check this foreign object is not requeired
+ my %req = map { $_ => 1 } $opts->{required};
+ if ($req{$field}) {
+ $errs->{$field}{FATAL} = "This is required. Please enter the required fields in this section."
+ }
+ }
+ }
}
+ #warn "Validated inputs are " . Dumper($validated);
undef $errs unless keys %$errs;
return ($errs, $validated);
}
-sub _validate {
- my ($self, $h, $wanted, $updating) = @_;
- my %required = map { $_ => 1 } @{$wanted->{required}};
+=head2 validate_inputs
+
+$self->validate_inputs($h, $opts);
+
+=cut
+
+sub validate_inputs {
+ my ($self, $h, $opts) = @_;
+ my $updating = $opts->{updating};
+ my %required = map { $_ => 1 } @{$opts->{required}};
my %seen;
- $seen{$_}++ foreach @{$wanted->{ignore}};
+ $seen{$_}++ foreach @{$opts->{ignore}};
my $errors = {};
my $fields = {};
- $wanted->{all} = [ $self->columns ] unless @{$wanted->{all} || [] } ;
- foreach my $field (@{$wanted->{required}}, @{$wanted->{all}}) {
+ $opts->{all} = [ $self->columns ] unless @{$opts->{all} || [] } ;
+ foreach my $field (@{$opts->{required}}, @{$opts->{all}}) {
next if $seen{$field}++;
my $type = $self->untaint_type($field) or
do { warn "No untaint type for $self 's field $field. Ignoring.";
$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
- }
- }
+# 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
- my $me_obj = eval { $self->insert($validated) };
+ #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 $@";
+ warn "Just failed making a " . $self. " FATAL Error is $@"
+ if (eval{$self->model_debug});
$errors->{FATAL} = $@;
return (undef, $errors);
}
}
}
- # Make other related (must_have, might_have, has_many , etc )
+ # Make other related (must_have, might_have, has_many etc )
foreach $accssr ( keys %related ) {
my ($rel_obj, $errs) =
$me_obj->_create_related($accssr, $related{$accssr});
$errors->{$accssr} = $errs if $errs;
+
}
+ warn "Errors are " . Dumper($errors);
undef $errors unless keys %$errors;
return ($me_obj, $errors);
}
my $rel_type = $rel_meta->{name};
my $fclass = $rel_meta->{foreign_class};
+ warn " Dumper of meta is " . Dumper($rel_meta);
+
my ($rel, $errs);
- if ($rel_type ne 'has_own' or $rel_type ne 'has_a') {
- # set up params for might_have, has_many, etc
- $params->{ $rel_meta->{args}{foreign_column} } = $self->id;
- %$params = ( %$params, %{$rel_meta->{args}->{constraint} || {}} );
- ($rel, $errs) = $fclass->_do_create_all($params, $created);
+
+ # 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);
+=head2 classify_form_inputs
+
+$self->classify_form_inputs($params[, $delimiter]);
-########################
-# classify_form_inputs #
-########################
-################################################################################
-# Foreign inputs are inputs that have data for a related table.
-# We must name them so we can tell which related class they belong to.
-# This assumes the form : $accessor . $delimeter . $column.
-#
-# Example Customer must_have person which is a
-# CstmrPrsn which has_a Person;
-#
-# Customer->must_have('cstmrprsn' => 'CstmrPrsn');
-# CstmrPrsn->has_own('prsn_id' => 'Person');
-#
-# If you say: Customer->to_field('cstmrprsn');
-# AsForm makes inputs for CstmrPrsn which leads to inputs for Person (first
-# _name, last_name, etc);
-# We need to keep track that the Person inputs are not related to Customer
-# directly but to the CstmrPrsn object which is related to Customer.
-#
-# Input Names end up like so:
-# cstmr_type # Customer column
-# cstmrprsn__AF__role # CstmrPrsn column
-# cstmrprsn__AF__person__AF__first_name # Person column
-# cstmrprsn__AF__person__AF__last_name # Person column
-#
-#
-# So our job is to rehash the inputs into a multi level hash keyed on
-# column or virtual column (accessor) names.
-#
-#
-###############################################################################
-
-=head2 classify_form_inputs
+Foreign inputs are inputs that have data for a related table.
+They come named so we can tell which related class they belong to.
+This assumes the form : $accessor . $delimeter . $column recursively
+classifies them into hashes. It returns a hashref.
=cut
my %hashed = ();
my $bottom_level;
$delimiter ||= $self->foreign_input_delimiter;
- # Put forminputs in own hashes by accessor (class they belong too)
- # AsForm makes "$accessor__AF__columnname" form for foeign inputs
foreach my $input_name (keys %$params) {
my @accssrs = split /$delimiter/, $input_name;
my $col_name = pop @accssrs;
smallint => 'integer',
mediumint => 'integer',
int => 'integer',
+ integer => 'integer',
bigint => 'integer',
year => 'integer',
date => 'date',
=head1 AUTHORS
-Peter Speltz, Aaron Trevena
+Peter Speltz
=head1 AUTHORS EMERITUS
=head1 TODO
+* Tests
+* add_to_from_cgi, search_from_cgi
* complete documentation
* ensure full backward compatibility with Class::DBI::FromCGI
projects / maypole.git / commitdiff