X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FAsForm.pm;h=f1fe978b1c36e7273f883d54a364cda003ec97ae;hb=c3973978e1373a262d13da63c9e9ecfde4b72cc7;hp=70a7eb46ff32012b44fb3ea4d40207dd0122400d;hpb=5cf53113b8fbb5da3bde167aee4b61f091a78677;p=maypole.git diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index 70a7eb4..f1fe978 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -11,6 +11,7 @@ package Maypole::Model::CDBI::AsForm; # -- $class->to_field($has_many_col); # foreign inputs # $class->search_inputs; / + use strict; use warnings; @@ -21,18 +22,19 @@ use HTML::Element; use Carp qw/cluck/; 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 _to_hidden _to_link_hidden _rename_foreign_input _to_readonly _options_from_objects _options_from_arrays _options_from_hashes - _options_from_scalars _to_select_or_create + _options_from_array _options_from_hash ); -our $VERSION = '.09'; +our $VERSION = '.10'; =head1 NAME @@ -55,33 +57,34 @@ Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns end_form; } - # Example of has_many select - - package Job; - __PACKAGE__->has_a('job_employer' => 'Employer'); - __PACKAGE__->has_a('contact' => 'Contact') +# Example of has_many select +package Job; +__PACKAGE__->has_a('job_employer' => 'Employer'); +__PACKAGE__->has_a('contact' => 'Contact') - package Contact; - __PACKAGE__->has_a('cont_employer' => 'Employer'); - __PACKAGE__->has_many('jobs' => 'Job', +package Contact; +__PACKAGE__->has_a('cont_employer' => 'Employer'); +__PACKAGE__->has_many('jobs' => 'Job', { join => { job_employer => 'cont_employer' }, constraint => { 'finshed' => 0 }, order_by => "created ASC", } - ); +); - package Employer; - __PACKAGE__->has_many('jobs' => 'Job',); - __PACKAGE__->has_many('contacts' => 'Contact', +package Employer; +__PACKAGE__->has_many('jobs' => 'Job',); +__PACKAGE__->has_many('contacts' => 'Contact', order_by => 'name DESC', - ); +); - # Choose some jobs to add to a contact (has multiple attribute). - my $job_sel = Contact->to_field('jobs'); # Uses constraint and order by + # Choose some jobs to add to a contact (has multiple attribute). + my $job_sel = Contact->to_field('jobs'); # Uses constraint and order by + - # Choose a job from $contact->jobs - my $job_sel = $contact->to_field('jobs'); + # Choose a job from $contact->jobs + my $job_sel = $contact->to_field('jobs'); + =head1 DESCRIPTION @@ -106,6 +109,8 @@ example usages. Not all _to_* methods pay attention to all arguments. For example, '_to_textfield' does not look in $args->{'items'} at all. +=over + =item name -- the name the element will have , this trumps the derived name. $beer->to_field('brewery', 'readonly', { @@ -193,6 +198,8 @@ static values. You can also specify these in the relationship arguments. Tell AsForm not to make hidden inputs for relationship constraints. It does this sometimes when making foreign inputs . +=back + =head2 to_cgi $self->to_cgi([@columns, $args]); @@ -220,18 +227,25 @@ columns and a hashref of hashes of arguments for each column. If called with an sub to_cgi { my ($class, @columns) = @_; # pjs -- added columns arg - my $args = ref $columns[-1] ? pop @columns : {}; - use Data::Dumper; - warn "Args are " . Dumper($args); - @columns = $class->columns unless (@columns); + my $args = {}; + if (not @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; } + } map { $_ => $class->to_field($_, $args->{$_}) } @columns; } =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. @@ -241,14 +255,21 @@ See C. You can also pass this argument in $args->{how}. =cut sub to_field { - my ($self, $field, $how, $args) = @_; - if (ref $how) { $args = $how; } - unless ($how) { $how = $args->{how} || ''; } - - return $self->_field_from_how($field, $how, $args) || - $self->_field_from_relationship($field, $args) || - $self->_field_from_column($field, $args) || - $self->_to_textfield($field, $args); + my ($self, $field, $how, $args) = @_; + if (ref $how) { $args = $how; $how = ''; } + unless ($how) { $how = $args->{how} || ''; } +#warn "In to_field field is $field how is $how. args ar e" . Dumper($args) . " \n"; + + #if (ref $field) { $args = $field; $field = '' } + + #use Data::Dumper; + #warn "args to_field are $field, . " . Dumper($how) . " , " . Dumper($args); + + + return $self->_field_from_how($field, $how, $args) || + $self->_field_from_relationship($field, $args) || + $self->_field_from_column($field, $args) || + $self->_to_textfield($field, $args); } =head2 search_inputs @@ -278,7 +299,6 @@ Example: sub search_inputs { my ($class, $args) = @_; - warn "In new Search Inputs"; $class = ref $class || $class; #my $accssr_class = { $class->accessor_classes }; my %cgi; @@ -303,13 +323,37 @@ sub search_inputs { # unset the default values for a select box foreach (keys %$fcgi) { - #$class->unselect_element($fcgi->{$_}); + my $el = $fcgi->{$_}; + if ($el->tag eq 'select') { + + $class->unselect_element($el); + my ($first, @content) = $el->content_list; + my @fc = $first->content_list; + my $val = $first ? $first->attr('value') : undef; + if ($first and (@fc > 0 or (defined $val and $val ne '')) ) { # something ( $first->attr('value') ne '' or + + #(defined $first->attr('value') or $first->attr('value') ne '')) + # push an empty option on stactk + $el->unshift_content(HTML::Element->new('option')); + } + } + } $cgi{$accssr} = $fcgi; delete $base_args->{columns}; - } else { + } + else { $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$field} }); - #$class->unselect_element($cgi{$field}); + my $el = $cgi{$field}; + if ($el->tag eq 'select') { + $class->unselect_element($el); + my ($first, @content) = $el->content_list; + if ($first and $first->content_list) { # something + #(defined $first->attr('value') or $first->attr('value') ne '')) + # push an empty option on stactk + $el->unshift_content(HTML::Element->new('option')); + } + } } } return \%cgi; @@ -317,7 +361,12 @@ sub search_inputs { -# + +=head2 unselect_element + + unselect any selected elements in a HTML::Element select list widget + +=cut sub unselect_element { my ($self, $el) = @_; #unless (ref $el eq 'HTML::Element') { @@ -338,7 +387,6 @@ Override at will. sub _field_from_how { my ($self, $field, $how, $args) = @_; - if (ref $how) { $args = $how; $how = undef; } return unless $how; $args ||= {}; no strict 'refs'; @@ -371,7 +419,6 @@ sub _field_from_relationship { my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0; # maybe has_a select - #warn "Dumper of relmeta. " . Dumper($rel_meta); if ($rel_meta->{name} eq 'has_a' and $fclass_is_cdbi) { # This condictions allows for trumping of the has_a args if (not $rel_meta->{args}{no_select} and not $args->{no_select}) @@ -387,7 +434,8 @@ sub _field_from_relationship { if (not $rel_meta->{args}{no_select} and not $args->{no_select}) { $args->{class} = $fclass; - $args->{items} = $self->$field; + my @itms = $self->$field; # need list not iterator + $args->{items} = \@itms; return $self->_to_select($field, $args); } return; @@ -414,7 +462,7 @@ sub _field_from_relationship { } return; } - + =head2 _field_from_column($field, $args) Returns an input based on the column's characteristics, namely type, or nothing. @@ -423,32 +471,33 @@ Override at will. =cut sub _field_from_column { - my ($self, $field, $args) = @_; - return unless $field; - my $class = ref $self || $self; - # Get column type - unless ($args->{column_type}) { - if ($class->can('column_type')) { - $args->{column_type} = $class->column_type($field); - } else { - # Right, have some of this - eval "package $class; Class::DBI::Plugin::Type->import()"; - $args->{column_type} = $class->column_type($field); + my ($self, $field, $args) = @_; + return unless $field; + my $class = ref $self || $self; + # Get column type + unless ($args->{column_type}) { + if ($class->can('column_type')) { + $args->{column_type} = $class->column_type($field); + } + else { + # Right, have some of this + eval "package $class; Class::DBI::Plugin::Type->import()"; + $args->{column_type} = $class->column_type($field); + } } - } - my $type = $args->{column_type}; - - return $self->_to_textfield($field, $args) - if $type and $type =~ /(VAR)?CHAR/i; #common type - return $self->_to_textarea($field, $args) - if $type and $type =~ /^(TEXT|BLOB)$/i; - return $self->_to_enum_select($field, $args) - if $type and $type =~ /^ENUM\((.*?)\)$/i; - return $self->_to_bool_select($field, $args) - if $type and $type =~ /^BOOL/i; - return $self->_to_readonly($field, $args) - if $type and $type =~ /^readonly$/i; - return; + my $type = $args->{column_type}; + + return $self->_to_textfield($field, $args) + if $type and $type =~ /^(VAR)?CHAR/i; #common type + return $self->_to_textarea($field, $args) + if $type and $type =~ /^(TEXT|BLOB)$/i; + return $self->_to_enum_select($field, $args) + if $type and $type =~ /^ENUM\((.*?)\)$/i; + return $self->_to_bool_select($field, $args) + if $type and $type =~ /^BOOL/i; + return $self->_to_readonly($field, $args) + if $type and $type =~ /^readonly$/i; + return; } @@ -480,6 +529,8 @@ sub _to_textarea { sub _to_textfield { my ($self, $col, $args ) = @_; + use Carp qw/confess/; + confess "No col passed to _to_textfield" unless $col; $args ||= {}; my $val = $args->{value}; my $name = $args->{name} || $col; @@ -492,7 +543,6 @@ sub _to_textfield { $val = $self->can($col) ? $self->$col : ''; # in case it is a virtual column if (ref $val) { if (my $meta = $self->related_meta('',$col)) { - #warn "Meta for $col"; if (my $code = $meta->{args}{deflate4edit} || $meta->{args}{deflate} ) { $val = ref $code ? &$code($val) : $val->$code; } @@ -505,7 +555,6 @@ sub _to_textfield { } } else { - #warn "No meta for $col but ref $val.\n"; $val = $val->id if $val->isa("Class::DBI"); } } @@ -516,9 +565,11 @@ sub _to_textfield { $val = '' unless defined $val; } } - my $a = HTML::Element->new("input", type => "text", name => $name, value => - $val); - + my $a; + # THIS If section is neccessary or you end up with "value" for a vaiue + # if val is + $val = '' unless defined $val; + $a = HTML::Element->new("input", type => "text", name => $name, value =>$val); $OLD_STYLE && return $a->as_HTML; $a; } @@ -601,15 +652,15 @@ sub _to_textfield { sub _to_select { my ($self, $col, $args) = @_; $args ||= {}; -# Do we have items already ? Go no further. - if ($args->{items} and @{$args->{items}}) { + # Do we have items already ? Go no further. + if ($args->{items} and ref $args->{items}) { my $a = $self->_select_guts($col, $args); $OLD_STYLE && return $a->as_HTML; if ($args->{multiple}) { $a->attr('multiple', 'multiple');} return $a; } -# Else what are we making a select box out of ? + # Else what are we making a select box out of ? # No Column parameter -- means making a select box of args->class or self # Using all rows from class's table if (not $col) { @@ -627,7 +678,7 @@ sub _to_select { # related objects pre selected if object # "Has many" -- Issues: - # 1) want to select one from list if self is an object + # 1) want to select one or many from list if self is an object # Thats about all we can do really, # 2) except for mapping which is TODO and would # do something like add to and take away from list of permissions for @@ -635,7 +686,8 @@ sub _to_select { # Hasmany select one from list if ref self if ($rel_meta->{name} =~ /has_many/i and ref $self) { - $args->{items} = [ $self->$col ]; + my @itms = $self->$col; # need list not iterator + $args->{items} = \@itms; my $a = $self->_select_guts($col, $args); $OLD_STYLE && return $a->as_HTML; return $a; @@ -672,9 +724,8 @@ sub _to_select { # Get items to select from $args->{items} = _select_items($args); - #warn "Items selecting from are " . Dumper($args->{items}); -#use Data::Dumper; -#warn "Just got items. They are " . Dumper($args->{items}); + #use Data::Dumper; + #warn "Just got items. They are " . Dumper($args->{items}); # Make select HTML element $a = $self->_select_guts($col, $args); @@ -714,7 +765,7 @@ sub _select_items { #foreach (@pks) { push @sel_cols, $_ unless $isect{$_}; } #push @sel_cols, @disp_cols; - warn "in select items. args are : " . Dumper($args); + #warn "in select items. args are : " . Dumper($args); my $distinct = ''; if ($args->{'distinct'}) { $distinct = 'DISTINCT '; @@ -726,7 +777,7 @@ sub _select_items { $sql .= " WHERE " . $args->{where} if $args->{where}; $sql .= " ORDER BY " . $args->{order_by} if $args->{order_by}; $sql .= " LIMIT " . $args->{limit} if $args->{limit}; -warn "_select_items sql is : $sql"; + #warn "_select_items sql is : $sql"; return $fclass->db_Main->selectall_arrayref($sql); @@ -736,19 +787,16 @@ warn "_select_items sql is : $sql"; # Makes a readonly input box out of column's value # No args makes object to readonly sub _to_readonly { - my ($self, $col, $val) = @_; - if (! $col) { # object to readonly + my ($self, $col, $args) = @_; + my $val = $args->{value}; + if (not defined $val ) { # object to readonly + $self->_croak("AsForm: To readonly field called as class method without a value") unless ref $self; $val = $self->id; $col = $self->primary_column; } - unless (defined $val) { - $self->_croak("Cannot get value in _to_readonly .") - unless ref $self; - $val = $self->$col; - } my $a = HTML::Element->new('input', 'type' => 'text', readonly => '1', 'name' => $col, 'value'=>$val); -$OLD_STYLE && return $a->as_HTML; + $OLD_STYLE && return $a->as_HTML; $a; } @@ -764,7 +812,8 @@ This will not work unless you write your own column_type method in your model. =cut sub _to_enum_select { - my ($self, $col, $type) = @_; + my ($self, $col, $args) = @_; + my $type = $args->{column_type}; $type =~ /ENUM\((.*?)\)/i; (my $enum = $1) =~ s/'//g; my @enum_vals = split /\s*,\s*/, $enum; @@ -776,7 +825,6 @@ sub _to_enum_select { $selected = eval{$self->column_default($col)} unless defined $selected; $selected = $enum_vals[0] unless defined $selected; - my $a = HTML::Element->new("select", name => $col); for ( @enum_vals ) { my $sel = HTML::Element->new("option", value => $_); @@ -803,7 +851,6 @@ TODO -- test without bool string. # TCODO fix this mess with args sub _to_bool_select { my ($self, $col, $args) = @_; - warn "In to_bool select"; my $type = $args->{column_type}; my @bool_text = ('No', 'Yes'); if ($type =~ /BOOL\((.+?)\)/i) { @@ -889,13 +936,13 @@ sub _to_link_hidden { $name = $args->{name} || $obj->primary_column->name; } elsif ($obj = $args->{items}->[0]) { - # cool) - $name = $args->{name} || $obj->primary_column->name; # TODO make use meta data + $name = $args->{name} || $accessor || $obj->primary_column->name; + # TODO use meta data above maybe } - else { # hiding linking related object with id in args $obj = $self->related_class($r, $accessor)->retrieve($args->{id}); - $name = $args->{name} || $obj->primary_column->name; # TODO make use meta data + $name = $args->{name} || $accessor ; #$obj->primary_column->name; + # TODO use meta data above maybe } $self->_croak("_to_link_hidden has no object") unless ref $obj; my $href = $uri || $r->config->{uri_base} . "/". $obj->table."/view/".$obj->id; @@ -906,8 +953,6 @@ sub _to_link_hidden { $a; } - - =head2 _to_foreign_inputs $html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]); @@ -985,12 +1030,15 @@ Below handles these formats for the "selected" slot in the arguments hash: sub _hash_selected { my ($args) = shift; my $selected = $args->{value} || $args->{selected}; - return $selected unless $selected and ref $selected ne 'HASH'; - warn "Selected dump : " . Dumper($selected); + #warn "**** SELECTED is $selected ****"; my $type = ref $selected; + return $selected unless $selected and $type ne 'HASH'; + #warn "Selected dump : " . Dumper($selected); # Single Object if ($type and $type ne 'ARRAY') { - return {$selected->id => 1}; + my $id = $selected->id; + $id =~ s/^0*//; + return {$id => 1}; } # Single Scalar id elsif (not $type) { @@ -1022,16 +1070,21 @@ sub _hash_selected { return \%hashed; } else { warn "AsForm Could not hash the selected argument: $selected"; } -} +} + -=head2 _select_guts + + +=head2 _select_guts Internal api method to make the actual select box form elements. 3 types of lists making for -- + Hash, Array, Array of CDBI objects. Array of scalars , - Array or Array refs with cols from class. + Array or Array refs with cols from class, + Array of hashes =cut @@ -1041,6 +1094,7 @@ sub _select_guts { my ($self, $col, $args) = @_; #$nullable, $selected_id, $values) = @_; #$args->{stringify} ||= 'stringify_selectbox'; + $args->{selected} = _hash_selected($args) if defined $args->{selected}; my $name = $args->{name} || $col; my $a = HTML::Element->new('select', name => $name); @@ -1053,42 +1107,59 @@ sub _select_guts { $a->push_content($null_element); } - my $items = $args->{items}; - my $proto = $items->[0]; - my $type = ref $proto || ''; - - # Objects - if (not $type) { - $a->push_content($self->_options_from_scalars($items, $args)); - } - elsif($type !~ /ARRAY|HASH/i) { - # make select of objects - $a->push_content($self->_options_from_objects($items, $args)); - } - elsif ($type =~ /ARRAY/i) { - $a->push_content($self->_options_from_arrays($items, $args)); + my $items = $args->{items}; + my $type = ref $items; + my $proto = eval { ref $items->[0]; } || ""; + my $optgroups = $args->{optgroups} || ''; + + # Array of hashes, one for each optgroup + if ($optgroups) { + my $i = 0; + foreach (@$optgroups) { + my $ogrp= HTML::Element->new('optgroup', label => $_); + $ogrp->push_content($self->_options_from_hash($items->[$i], $args)); + $a->push_content($ogrp); + $i++; + } + } + # Single Hash + elsif ($type eq 'HASH') { + $a->push_content($self->_options_from_hash($items, $args)); + } + # Single Array + elsif ( $type eq 'ARRAY' and not ref $items->[0] ) { + $a->push_content($self->_options_from_array($items, $args)); + } + # Array of Objects + elsif( $type eq 'ARRAY' and $proto !~ /ARRAY|HASH/i ) { + # make select of objects + $a->push_content($self->_options_from_objects($items, $args)); + } + # Array of Arrays + elsif ( $type eq 'ARRAY' and $proto eq 'ARRAY' ) { + $a->push_content($self->_options_from_arrays($items, $args)); } - elsif ($type =~ /HASH/i) { - $a->push_content($self->_options_from_hashes($items, $args)); + # Array of Hashes + elsif ( $type eq 'ARRAY' and $proto eq 'HASH' ) { + $a->push_content($self->_options_from_hashes($items, $args)); } - else { - die "You passed a weird type of data structure to me. Here it is: $type"; + else { + die "You passed a weird type of data structure to me. Here it is: " . + Dumper($items ); } return $a; -} - - - - +} =head2 _options_from_objects ( $objects, $args); Private method to makes a options out of objects. It attempts to call each objects stringify method specified in $args->{stringify} as the content. Otherwise the default stringification prevails. +*Note only single primary keys supported + =cut sub _options_from_objects { my ($self, $items, $args) = @_; @@ -1096,8 +1167,10 @@ sub _options_from_objects { my $stringify = $args->{stringify} || ''; my @res; for (@$items) { - my $opt = HTML::Element->new("option", value => $_->id); - $opt->attr(selected => "selected") if $selected->{$_->id}; + my $id = $_->id; + my $opt = HTML::Element->new("option", value => $id); + $id =~ s/^0*//; # leading zeros no good in hash key + $opt->attr(selected => "selected") if $selected->{$id}; my $content = $stringify ? $_->stringify : "$_"; $opt->push_content($content); push @res, $opt; @@ -1115,10 +1188,11 @@ sub _options_from_arrays { my @pks; # for future multiple key support push @pks, shift @$item foreach $class->columns('Primary'); my $id = $pks[0]; - $id =~ ~ s/^0+//; # In case zerofill is on . - my $opt = HTML::Element->new("option", value => $id ); + $id =~ s/^0+//; # In case zerofill is on . + my $val = defined $id ? $id : ''; + my $opt = HTML::Element->new("option", value =>$val); $opt->attr(selected => "selected") if $selected->{$id}; - + my $content = ($class and $stringify and $class->can($stringify)) ? $class->$stringify($_) : join( '/', map { $_ if $_; }@{$item} ); @@ -1128,20 +1202,41 @@ sub _options_from_arrays { return @res; } -sub _options_from_scalars { + +sub _options_from_array { my ($self, $items, $args) = @_; - my $selected = $args->{selected} || {}; + my $selected = $args->{selected} || {}; my @res; - for (@$items) { - my $opt = HTML::Element->new("option", value => $_ ); - #$opt->attr(selected => "selected") if $selected =~/^$id$/; - $opt->attr(selected => "selected") if $selected->{$_}; - $opt->push_content( $_ ); - push @res, $opt; + for (@$items) { + my $val = defined $_ ? $_ : ''; + my $opt = HTML::Element->new("option", value => $val); + #$opt->attr(selected => "selected") if $selected =~/^$id$/; + $opt->attr(selected => "selected") if $selected->{$_}; + $opt->push_content( $_ ); + push @res, $opt; + } + return @res; +} + +sub _options_from_hash { + my ($self, $items, $args) = @_; + my $selected = $args->{selected} || {}; + my @res; + + my @values = values %$items; + # hash Key is the option content and the hash value is option value + for (sort keys %$items) { + my $val = defined $items->{$_} ? $items->{$_} : ''; + my $opt = HTML::Element->new("option", value => $val); + #$opt->attr(selected => "selected") if $selected =~/^$id$/; + $opt->attr(selected => "selected") if $selected->{$items->{$_}}; + $opt->push_content( $_ ); + push @res, $opt; } return @res; } + sub _options_from_hashes { my ($self, $items, $args) = @_; my $selected = $args->{selected} || {}; @@ -1150,28 +1245,30 @@ sub _options_from_hashes { my $stringify = $args->{stringify} || ''; my @res; for (@$items) { - my $val = $_->{$pk}; - my $opt = HTML::Element->new("option", value => $val ); + my $val = defined $_->{$pk} ? $_->{$pk} : ''; + my $opt = HTML::Element->new("option", value => $val); $opt->attr(selected => "selected") if $selected->{$val}; my $content = ($fclass and $stringify and $fclass->can($stringify)) ? - $fclass->$stringify($_) : join(' ', @$_); + $fclass->$stringify($_) : + join(' ', @$_); $opt->push_content( $content ); push @res, $opt; } return @res; } -sub _to_select_or_create { - my ($self, $col, $args) = @_; - $args->{name} ||= $col; - my $select = $self->to_field($col, 'select', $args); - $args->{name} = "create_" . $args->{name}; - my $create = $self->to_field($col, 'foreign_inputs', $args); - $create->{'__select_or_create__'} = - $self->to_field('__select_or_create__',{ name => '__select_or_create__' , value => 1 } ); - return ($select, $create); -} - +# TODO -- Maybe +#sub _to_select_or_create { +# my ($self, $col, $args) = @_; +# $args->{name} ||= $col; +# my $select = $self->to_field($col, 'select', $args); +# $args->{name} = "create_" . $args->{name}; +# my $create = $self->to_field($col, 'foreign_inputs', $args); +# $create->{'__select_or_create__'} = +# $self->to_field('__select_or_create__',{ name => '__select_or_create__' , value => 1 } ); +# return ($select, $create); +#} + # # checkboxes: if no data in hand (ie called as class method), replace # with a radio button, in order to allow this field to be left @@ -1184,7 +1281,6 @@ sub _to_select_or_create { sub _to_checkbox { my ($self, $col, $args) = @_; my $nullable = eval {self->column_nullable($col)} || 0; - return $self->_to_radio($col) if !ref($self) || $nullable; my $value = $self->$col; my $a = HTML::Element->new("input", type=> "checkbox", name => $col); @@ -1223,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 @@ -1276,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; @@ -1302,16 +1395,16 @@ sub _box 1; -=head1 CHANGES +=head1 CHANGES -=head1 MAINTAINER +=head1 MAINTAINER Maypole Developers =head1 AUTHORS -Peter Speltz, Aaron Trevena +Peter Speltz, Aaron Trevena =head1 AUTHORS EMERITUS @@ -1331,12 +1424,11 @@ Simon Cozens, Tony Bowden =head1 BUGS and QUERIES Please direct all correspondence regarding this module to: - Maypole list. + Maypole list. =head1 COPYRIGHT AND LICENSE -Copyright 2003-2004 by Simon Cozens and Tony Bowden -Copyright 2005-2006 by Aaron Trevena and Peter Speltz +Copyright 2003-2004 by Simon Cozens / Tony Bowden This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. @@ -1346,3 +1438,4 @@ it under the same terms as Perl itself. L, L, L. =cut +