From c3973978e1373a262d13da63c9e9ecfde4b72cc7 Mon Sep 17 00:00:00 2001 From: biopete Date: Tue, 11 Jul 2006 17:03:06 +0000 Subject: [PATCH] Fixed FromCGI and AsForm some more. No official tests in crud.t yet but i have a working demo and will move code to synopsis or tests. The macros, i just tweaked it a little so it would display and array in view_item and make a default name out of column name if colnames has no entry for "column". git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@503 48953598-375a-da11-a14b-00016c27c3ee --- lib/Maypole/Model/CDBI.pm | 44 ++++- lib/Maypole/Model/CDBI/AsForm.pm | 65 +++--- lib/Maypole/Model/CDBI/FromCGI.pm | 285 ++++++++++++++------------- lib/Maypole/templates/factory/macros | 11 +- 4 files changed, 228 insertions(+), 177 deletions(-) diff --git a/lib/Maypole/Model/CDBI.pm b/lib/Maypole/Model/CDBI.pm index 933fc55..e65caa2 100644 --- a/lib/Maypole/Model/CDBI.pm +++ b/lib/Maypole/Model/CDBI.pm @@ -80,8 +80,8 @@ sub do_edit : Exported { return; } - my $required_cols = $config->{$table}->{required_cols} || []; - my $ignored_cols = $r->{config}{ $r->{table} }{ignore_cols} || []; + my $required_cols = $config->{$table}{required_cols} || []; + my $ignored_cols = $config->{$table}{ignore_cols} || []; ($obj, my $fatal, my $creating) = $self->_do_update_or_create($r, $obj, $required_cols, $ignored_cols); @@ -135,16 +135,16 @@ sub _do_update_or_create { # update or create if ($obj) { # We have something to edit - eval { $obj->update_from_cgi( $h => { + eval { $obj->update_from_cgi( $r => { 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 => { + $obj = $self->create_from_cgi( $r => { required => $required_cols, ignore => $ignored_cols, } ); @@ -152,11 +152,43 @@ sub _do_update_or_create { $fatal = $@; $creating++; } - return $obj, $fatal, $creating; } +# split out from do_edit to be reported by Mp::P::Trace +#sub _do_update_or_create { +# my ($self, $r, $obj, $required_cols, $ignored_cols) = @_; +# +# my $fatal; +# my $creating = 0; +# +# my $h = $self->Untainter->new( %{$r->params} ); +# +# # update or create +# if ($obj) { +# # 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 => { +# required => $required_cols, +# ignore => $ignored_cols, +# } ); +# }; +# $fatal = $@; +# $creating++; +# } +# +# return $obj, $fatal, $creating; +#} + =head2 delete Deprecated method that calls do_delete or a given classes delete method, please diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index 7956bbb..f1fe978 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -25,7 +25,7 @@ our $OLD_STYLE = 0; # 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 @@ -229,7 +229,9 @@ sub to_cgi { 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; } @@ -240,8 +242,10 @@ sub to_cgi { =head2 to_field($field [, $how][, $args]) This maps an individual column to a form element. The C 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 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. @@ -1315,52 +1319,48 @@ sub _to_radio { _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 @@ -1368,9 +1368,10 @@ or the defaults. =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; diff --git a/lib/Maypole/Model/CDBI/FromCGI.pm b/lib/Maypole/Model/CDBI/FromCGI.pm index e342a28..0d1f86a 100644 --- a/lib/Maypole/Model/CDBI/FromCGI.pm +++ b/lib/Maypole/Model/CDBI/FromCGI.pm @@ -27,8 +27,8 @@ use CGI::Untaint::Maypole; 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/; @@ -96,27 +96,32 @@ Based on the same method in Class::DBI::FromCGI. 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) { @@ -126,7 +131,7 @@ sub create_from_cgi { # 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; } @@ -135,51 +140,50 @@ sub create_from_cgi { =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); } @@ -206,68 +210,89 @@ of errors and validated data. =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."; @@ -323,28 +348,30 @@ sub _do_create_all { $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); } @@ -357,12 +384,14 @@ sub _do_create_all { } } - # 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); @@ -436,13 +465,21 @@ sub _create_related { } 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); @@ -457,41 +494,14 @@ sub _create_related { +=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 @@ -500,8 +510,6 @@ sub classify_form_inputs { 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; @@ -536,6 +544,7 @@ sub _column_type_for { smallint => 'integer', mediumint => 'integer', int => 'integer', + integer => 'integer', bigint => 'integer', year => 'integer', date => 'date', @@ -549,7 +558,7 @@ Maypole Developers =head1 AUTHORS -Peter Speltz, Aaron Trevena +Peter Speltz =head1 AUTHORS EMERITUS @@ -557,6 +566,8 @@ Tony Bowden =head1 TODO +* Tests +* add_to_from_cgi, search_from_cgi * complete documentation * ensure full backward compatibility with Class::DBI::FromCGI diff --git a/lib/Maypole/templates/factory/macros b/lib/Maypole/templates/factory/macros index 53f6952..c96cb17 100644 --- a/lib/Maypole/templates/factory/macros +++ b/lib/Maypole/templates/factory/macros @@ -138,7 +138,7 @@ This takes an object and and displays its properties in a table. [% INCLUDE navbar %] - + [% FOR col = classmetadata.columns.list; @@ -154,11 +154,18 @@ from the C method: #%] - +
[% classmetadata.colnames.$string %][% classmetadata.colnames.$string %] [% item.$string | html %]
[% classmetadata.colnames.$col; %][% classmetadata.colnames.$col || + col | ucfirst | replace('_',' '); %] [% IF col == "url" && item.url; # Possibly too much magic. ' '; item.url; ''; + ELSIF item.$col.size > 1; # has_many column + FOR thing IN item.$col; + maybe_link_view(thing);", "; + END; + ELSE; + maybe_link_view(item.$col); END; %] [%# -- 2.39.5