X-Git-Url: https://git.decadent.org.uk/gitweb/?p=maypole.git;a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FFromCGI.pm;h=0d1f86a5f0d4a87b97358c8975b1e59a9a70de02;hp=e342a28f45ab9d418507a4ece50f52206d59c96b;hb=c3973978e1373a262d13da63c9e9ecfde4b72cc7;hpb=2a0564f48a17a688c114fac6384bb2a4dd34865b 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