X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FAsForm.pm;h=1765482469927742eb67baca014c82eea5ec4114;hb=93f6780e2cd84eb4f9f6cfc578f42484bb2cf34b;hp=ef67a06e14ef4c8fd6ec0c2957da8a1e17773876;hpb=446373ada20165687d0c3b03a2ee18c08831be02;p=maypole.git
diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index ef67a06..1765482 100644
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -1,17 +1,12 @@
package Maypole::Model::CDBI::AsForm;
#TODO --
-# lots of doc
-# _to_select_or_create -- select input stays
-# _to_create_or_select -- create input trumps
-#
# TESTED and Works --
# has_many select -- $obj->to_field($has_many_col); # select one form many
# -- $class->to_field($has_many_col); # foreign inputs
# $class->search_inputs; /
-use 5.006;
use strict;
use warnings;
@@ -26,24 +21,16 @@ 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 @EXPORTOK =
- qw(
-
-
- );
-
-
-our $VERSION = '.10';
+our $VERSION = '.95';
=head1 NAME
@@ -66,34 +53,107 @@ 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')
-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",
- }
-);
+ . . .
+
+ # Somewhere else in a Maypole application about beer...
+
+
+
+
+ $beer->to_field('brewery', 'textfield', {
+ name => 'brewery_id', value => $beer->brewery,
+ # however, no need to set value since $beer is object
+ });
+
+ # Rate a beer
+ $beer->to_field(rating => select => {
+ items => [1 , 2, 3, 4, 5],
+ });
+
+ # Select a Brewery to visit in the UK
+ Brewery->to_field(brewery_id => {
+ items => [ Brewery->search_like(location => 'UK') ],
+ });
+
+ # Make a select for a boolean field
+ $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] });
+
+ $beer->to_field('brewery', {
+ selected => $beer->brewery, # again not necessary since caller is obj.
+ });
+
+
+ $beer->to_field('brewery', 'link_hidden', {r => $r, uri => 'www.maypole.perl.org/brewery/view/'.$beer->brewery});
+ # an html link that is also a hidden input to the object. R is required to
+ # make the uri unless you pass a uri
-package Employer;
-__PACKAGE__->has_many('jobs' => 'Job',);
-__PACKAGE__->has_many('contacts' => 'Contact',
- order_by => 'name DESC',
-);
+
+
+ #####################################################
+ # Templates Usage
+
+
+
+
+ #####################################################
+ # Advanced Usage
+
+ # 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',
+ { join => { job_employer => 'cont_employer' },
+ constraint => { 'finshed' => 0 },
+ order_by => "created ASC",
+ }
+ );
+
+ 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 a job from $contact->jobs
my $job_sel = $contact->to_field('jobs');
-
+
+ 1;
+
+
=head1 DESCRIPTION
@@ -117,20 +177,22 @@ example usages.
$beer->to_field($col, $args);
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', {
- name => 'brewery_id'
+ name => 'brewery_id'
});
-
+
=item value -- the initial value the element will have, trumps derived value
$beer->to_field('brewery', 'textfield', {
name => 'brewery_id', value => $beer->brewery,
# however, no need to set value since $beer is object
});
-
+
=item items -- array of items generally used to make select box options
Can be array of objects, hashes, arrays, or strings, or just a hash.
@@ -139,7 +201,7 @@ Can be array of objects, hashes, arrays, or strings, or just a hash.
$beer->to_field(rating => select => {
items => [1 , 2, 3, 4, 5],
});
-
+
# Select a Brewery to visit in the UK
Brewery->to_field(brewery_id => {
items => [ Brewery->search_like(location => 'UK') ],
@@ -161,11 +223,11 @@ Can be an simple scalar id, an object, or an array of either
This in almost always derived in cases where it may be difficult to derive, --
# Select beers to serve on handpump
Pub->to_field(handpumps => select => {
- class => 'Beer', order_by => 'name ASC', multiple => 1,
+ class => 'Beer', order_by => 'name ASC', multiple => 1,
});
=item column_type -- a string representing column type
-
+
$pub->to_field('open', 'bool_select', {
column_type => "bool('Closed', 'Open'),
});
@@ -175,15 +237,15 @@ This in almost always derived in cases where it may be difficult to derive, --
Generally this can be set to get or not get a null/empty option added to
a select box. AsForm attempts to call "$class->column_nullable" to set this
and it defaults to true if there is no shuch method.
-
+
$beer->to_field('brewery', { column_nullable => 1 });
-=item r or request -- the mapyole request object
+=item r or request -- the Mapyole request object
=item uri -- uri for a link , used in methods such as _to_link_hidden
$beer->to_field('brewery', 'link_hidden',
- {r => $r, uri => 'www.maypole.perl.org/brewery/view/'.$beer->brewery});
+ {r => $r, uri => 'www.maypole.perl.org/brewery/view/'.$beer->brewery});
# an html link that is also a hidden input to the object. R is required to
# make the uri unless you pass a uri
@@ -192,19 +254,22 @@ and it defaults to true if there is no shuch method.
These are used in making select boxes. order_by is a simple order by clause
and constraint and join are hashes used to limit the rows selected. The
difference is that join uses methods of the object and constraint uses
-static values. You can also specify these in the relationship arguments.
+static values. You can also specify these in the relationship definitions.
+See the relationships documentation of how to set arbitrayr meta info.
BeerDB::LondonBeer->has_a('brewery', 'BeerDB::Brewery',
- order_by => 'brewery_name ASC',
+ order_by => 'brewery_name ASC',
constraint => {location => 'London'},
'join' => {'brewery_tablecolumn => 'beer_obj_column'},
);
-
+
=item no_hidden_constraints --
Tell AsForm not to make hidden inputs for relationship constraints. It does
-this sometimes when making foreign inputs .
+this sometimes when making foreign inputs. However, i think it should not
+do this and that the FromCGI 's _create_related method should do it.
+=back
=head2 to_cgi
@@ -220,34 +285,38 @@ columns and a hashref of hashes of arguments for each column. If called with an
# and dont want to call to_field a bunch of times just to tweak one or
# two of them.
$self->to_cgi(@cols, {brewery => {
- how => 'textfield' # too big for select
+ how => 'textfield' # too big for select
},
- style => {
- column_nullable => 0,
- how => 'select',
- items => ['Ale', 'Lager']
+ style => {
+ column_nullable => 0,
+ how => 'select',
+ items => ['Ale', 'Lager']
}
- }
+ });
=cut
sub to_cgi {
- my ($class, @columns) = @_; # pjs -- added columns arg
- my $args = {};
- if (not @columns) {
- @columns = $class->columns;
- }
- else {
- if ( ref $columns[-1] eq 'HASH' ) { $args = pop @columns; }
- }
- map { $_ => $class->to_field($_, $args->{$_}) } @columns;
+ my ($class, @columns) = @_; # pjs -- added columns arg
+ 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.
+
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.
@@ -257,23 +326,27 @@ 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; $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);
-
+ 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";
+ # Set sensible default value
+ if ($field and not defined $args->{default}) {
+ my $def = $self->column_default($field) ;
+ # exclude defaults we don't want actually put as value for input
+ if (defined $def) {
+ $def = $def =~ /(^0000-00-00.*$|^0[0]*$|^0\.00$|CURRENT_TIMESTAMP|NULL)/i ? '' : $def ;
+ $args->{default} = $def;
+ }
+ }
- 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);
+ 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
my $cgi = $class->search_inputs ([$args]); # optional $args
@@ -290,7 +363,7 @@ the value is a list ref of columns to search on in the related class.
Example:
sub BeerDB::Beer::search_columns {
- return ( 'name' , 'rating', { brewery => [ 'name', 'location'] } );
+ return ( 'name' , 'rating', { brewery => [ 'name', 'location'] } );
}
# Now foreign inputs are made for Brewery name and location and the
@@ -300,79 +373,83 @@ Example:
sub search_inputs {
- my ($class, $args) = @_;
- $class = ref $class || $class;
- #my $accssr_class = { $class->accessor_classes };
- my %cgi;
-
- $args->{columns} ||= $class->can('search_columns') ?[$class->search_columns] : [$class->display_columns];
-
- foreach my $field ( @{ $args->{columns} } ) {
- my $base_args = {
- no_hidden_constraints => 1,
- column_nullable => 1, # empty option on select boxes
- value => '',
- };
- if ( ref $field eq "HASH" ) { # foreign search fields
- my ($accssr, $cols) = each %$field;
- $base_args->{columns} = $cols;
- unless ( @$cols ) {
- # default to search fields for related
- #$cols = $accssr_class->{$accssr}->search_columns;
- die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'");
- }
- my $fcgi = $class->to_field($accssr, 'foreign_inputs', $base_args);
-
- # unset the default values for a select box
- foreach (keys %$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 {
- $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$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'));
- }
- }
- }
+ my ($class, $args) = @_;
+ $class = ref $class || $class;
+ #my $accssr_class = { $class->accessor_classes };
+ my %cgi;
+
+ $args->{columns} ||= $class->can('search_columns') ?[$class->search_columns] : [$class->display_columns];
+
+ foreach my $field ( @{ $args->{columns} } ) {
+ my $base_args = {
+ no_hidden_constraints => 1,
+ column_nullable => 1, # empty option on select boxes
+ value => '',
+ };
+ if ( ref $field eq "HASH" ) { # foreign search fields
+ my ($accssr, $cols) = each %$field;
+ $base_args->{columns} = $cols;
+ unless ( @$cols ) {
+ # default to search fields for related
+ #$cols = $accssr_class->{$accssr}->search_columns;
+ die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'");
+ }
+ my $fcgi = $class->to_field($accssr, 'foreign_inputs', $base_args);
+
+ # unset the default values for a select box
+ foreach (keys %$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 {
+ $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$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;
+ }
+ return \%cgi;
}
-#
+
+=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') {
- #$self->_croak ('Need an HTML::Element to unselect. You gave a ' . Dumper($el)); }
- if ($el->tag eq 'select') {
- foreach my $opt ($el->content_list) {
- $opt->attr('selected', undef) if $opt->attr('selected');
- }
- }
+ my ($self, $el) = @_;
+ #unless (ref $el eq 'HTML::Element') {
+ #$self->_croak ('Need an HTML::Element to unselect. You gave a ' . Dumper($el)); }
+ if ($el->tag eq 'select') {
+ foreach my $opt ($el->content_list) {
+ $opt->attr('selected', undef) if $opt->attr('selected');
+ }
+ }
}
=head2 _field_from_how($field, $how,$args)
@@ -383,19 +460,17 @@ Override at will.
=cut
sub _field_from_how {
- my ($self, $field, $how, $args) = @_;
- #if (ref $how) { $args = $how; $how = undef; }
-#warn "In filed from how . filed is $field how is $how. args ar e" . Dumper($args) . " \n";
- return unless $how;
- $args ||= {};
- no strict 'refs';
- my $meth = "_to_$how";
- if (not $self->can($meth)) {
- warn "Class can not $meth";
+ my ($self, $field, $how, $args) = @_;
+ return unless $how;
+ $args ||= {};
+ no strict 'refs';
+ my $meth = "_to_$how";
+ if (not $self->can($meth)) {
+ warn "Class can not $meth";
+ return;
+ }
+ return $self->$meth($field, $args);
return;
- }
- return $self->$meth($field, $args);
- return;
}
=head2 _field_from_relationship($field, $args)
@@ -408,61 +483,48 @@ For has_a it will give select box
=cut
sub _field_from_relationship {
- my ($self, $field, $args) = @_;
-#warn "In filed from rel . filed is $field \n";
- return unless $field;
- my $rel_meta = $self->related_meta('r',$field) || return;
- my $rel_name = $rel_meta->{name};
- #my $meta = $self->meta_info;
- #grep{ defined $meta->{$_}{$field} } keys %$meta;
- my $fclass = $rel_meta->foreign_class;
- 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})
- {
- $args->{class} = $fclass;
- return $self->_to_select($field, $args);
+ my ($self, $field, $args) = @_;
+ return unless $field;
+ my $rel_meta = $self->related_meta('r',$field) || return;
+ my $rel_name = $rel_meta->{name};
+ #my $meta = $self->meta_info;
+ #grep{ defined $meta->{$_}{$field} } keys %$meta;
+ my $fclass = $rel_meta->foreign_class;
+ my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0;
+
+ # maybe has_a select
+ 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})
+ {
+ $args->{class} = $fclass;
+ return $self->_to_select($field, $args);
+ }
+ return;
}
- return;
- }
- # maybe has many select
- if ($rel_meta->{name} eq 'has_many' and $fclass_is_cdbi and ref $self) {
- # This condictions allows for trumping of the has_a args
- if (not $rel_meta->{args}{no_select} and not $args->{no_select})
+ # maybe has many select
+ if ($rel_meta->{name} eq 'has_many' and $fclass_is_cdbi and ref $self) {
+ # This condictions allows for trumping of the has_a args
+ if (not $rel_meta->{args}{no_select} and not $args->{no_select})
+ {
+ $args->{class} = $fclass;
+ my @itms = $self->$field; # need list not iterator
+ $args->{items} = \@itms;
+ return $self->_to_select($field, $args);
+ }
+ return;
+ }
+
+ # maybe foreign inputs
+ my %local_cols = map { $_ => 1 } $self->columns; # includes is_a cols
+ if ($fclass_is_cdbi and (not $local_cols{$field} or $rel_name eq 'has_own'))
{
- $args->{class} = $fclass;
- $args->{items} = $self->$field;
- return $self->_to_select($field, $args);
+ $args->{related_meta} = $rel_meta; # suspect faster to set these args
+ return $self->_to_foreign_inputs($field, $args);
}
return;
- }
-
-
-
- #NOOO! maybe select from has_many
-# if ($rel_type eq 'has_many' and ref $self) {
-# $args->{items} ||= [$self->$field];
-# # arg name || fclass pk name || field
-# if (not $args->{name}) {
-# $args->{name} = eval{$fclass->primary_column->name} || $field;
-# }
-# return $self->_to_select($field, $args);
-# }
-#
- # maybe foreign inputs
- my %local_cols = map { $_ => 1 } $self->columns; # includes is_a cols
- if ($fclass_is_cdbi and (not $local_cols{$field} or $rel_name eq 'has_own'))
- {
- $args->{related_meta} = $rel_meta; # suspect faster to set these args
- return $self->_to_foreign_inputs($field, $args);
- }
- return;
}
-
+
=head2 _field_from_column($field, $args)
Returns an input based on the column's characteristics, namely type, or nothing.
@@ -471,111 +533,116 @@ Override at will.
=cut
sub _field_from_column {
- my ($self, $field, $args) = @_;
- return unless $field;
- my $class = ref $self || $self;
- #warn "Class is $class\n";
- # Get column type
- unless ($args->{column_type}) {
- $args->{column_type} = $class->column_type($field);
- 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) = @_;
+ # this class and pk are default class and field at this point
+ my $class = $args->{class} || $self;
+ $class = ref $class || $class;
+ $field ||= ($class->primary_columns)[0]; # TODO
+
+ # 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;
}
sub _to_textarea {
- my ($self, $col, $args) = @_;
- # pjs added default
- $args ||= {};
- my $val = $args->{value};
-
- unless (defined $val) {
- if (ref $self) {
- $val = $self->$col;
- }
- else {
- $val = eval {$self->column_default($col);};
- $val = '' unless defined $val;
+ my ($self, $col, $args) = @_;
+ my $class = $args->{class} || $self;
+ $class = ref $class || $class;
+ $col ||= ($class->primary_columns)[0]; # TODO
+ # pjs added default
+ $args ||= {};
+ my $val = $args->{value};
+
+ unless (defined $val) {
+ if (ref $self) {
+ $val = $self->$col;
+ }
+ else {
+ $val = $args->{default};
+ $val = '' unless defined $val;
+ }
}
- }
- my ($rows, $cols) = _box($val);
- $rows = $args->{rows} if $args->{rows};
- $cols = $args->{cols} if $args->{cols};;
- my $name = $args->{name} || $col;
- my $a =
+ my ($rows, $cols) = _box($val);
+ $rows = $args->{rows} if $args->{rows};
+ $cols = $args->{cols} if $args->{cols};;
+ my $name = $args->{name} || $col;
+ my $a =
HTML::Element->new("textarea", name => $name, rows => $rows, cols => $cols);
- $a->push_content($val);
- $OLD_STYLE && return $a->as_HTML;
- $a;
+ $a->push_content($val);
+ $OLD_STYLE && return $a->as_HTML;
+ $a;
}
sub _to_textfield {
- my ($self, $col, $args ) = @_;
- $args ||= {};
- my $val = $args->{value};
- my $name = $args->{name} || $col;
-
- unless (defined $val) {
- if (ref $self) {
- # Case where column inflates.
- # Input would get stringification which could be not good.
- # as in the case of Time::Piece objects
- $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;
- }
- elsif ( $val->isa('Class::DBI') ) {
- $val = $val->id;
- }
- else {
- #warn "No deflate4edit code defined for $val of type " .
- #ref $val . ". Using the stringified value in textfield..";
- }
- }
- else {
- #warn "No meta for $col but ref $val.\n";
- $val = $val->id if $val->isa("Class::DBI");
- }
- }
-
- }
- else {
- $val = eval {$self->column_default($col);};
- $val = '' unless defined $val;
- }
- }
- my $a = HTML::Element->new("input", type => "text", name => $name, value =>
- $val);
+ 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;
+
+ unless (defined $val) {
+ if (ref $self) {
+ # Case where column inflates.
+ # Input would get stringification which could be not good.
+ # as in the case of Time::Piece objects
+ $val = $self->can($col) ? $self->$col : ''; # in case it is a virtual column
+ if (ref $val) {
+ if (my $meta = $self->related_meta('',$col)) {
+ if (my $code = $meta->{args}{deflate4edit} || $meta->{args}{deflate} ) {
+ $val = ref $code ? &$code($val) : $val->$code;
+ }
+ elsif ( $val->isa('Class::DBI') ) {
+ $val = $val->id;
+ }
+ else {
+ #warn "No deflate4edit code defined for $val of type " .
+ #ref $val . ". Using the stringified value in textfield..";
+ }
+ }
+ else {
+ $val = $val->id if $val->isa("Class::DBI");
+ }
+ }
- $OLD_STYLE && return $a->as_HTML;
- $a;
+ }
+ else {
+ $val = $args->{default};
+ $val = '' unless defined $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;
}
-# Too expensive version -- TODO
+# Old version
#sub _to_select {
# my ($self, $col, $hint) = @_;
# my $fclass = $hint || $self->__hasa_rels->{$col}->[0];
@@ -595,25 +662,21 @@ sub _to_textfield {
-# pjs
-# -- Rewrote this to be efficient -- no object creation.
-# -- Added option for CDBI classes to specify a limiting clause
-# via "has_a_select_limit".
-# -- Added selected argument to set a selected
=head2 recognized arguments
-
+
selected => $object|$id,
name => $name,
value => $value,
where => SQL 'WHERE' clause,
order_by => SQL 'ORDER BY' clause,
+ constraint => hash of constraints to search
limit => SQL 'LIMIT' clause,
items => [ @items_of_same_type_to_select_from ],
class => $class_we_are_selecting_from
stringify => $stringify_coderef|$method_name
-
-
+
+
# select box requirements
@@ -623,18 +686,18 @@ sub _to_textfield {
# related class and you choose one.
#Or explicitly you can create one and pass options like where and order
BeerDB::Beer->to_field('brewery','select', {where => "location = 'Germany'");
-
+
# For has_many the default is to get a multiple select box with all objects.
# If called as an object method, the objects existing ones will be selected.
Brewery::BeerDB->to_field('beers','select', {where => "rating > 5"});
-
+
=head2 2. a select box for objects of arbitrary class -- say BeerDB::Beer for fun.
# general
BeerDB::Beer->to_field('', 'select', $options)
BeerDB::Beer->to_field('', 'select'); # Select box of all the rows in class
- # with PK as ID, $Class->to_field() same.
+ # with PK as ID, $Class->to_field() same.
BeerDB::Beer->to_field('','select',{ where => "rating > 3 AND class like 'Ale'", order_by => 'rating DESC, beer_id ASC' , limit => 10});
# specify exact where clause
@@ -645,24 +708,24 @@ sub _to_textfield {
# 3. a select box for arbitrary set of objects
# Pass array ref of objects as first arg rather than field
$any_class_or_obj->to_field([BeerDB::Beer->search(favorite => 1)], 'select',);
-
+
=cut
sub _to_select {
- my ($self, $col, $args) = @_;
- $args ||= {};
-# Do we have items already ? Go no further.
- if ($args->{items} and @{$args->{items}}) {
- my $a = $self->_select_guts($col, $args);
+ my ($self, $col, $args) = @_;
+ $args ||= {};
+ # 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;
}
+
+ # Proceed with work
-# 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
+ my $rel_meta;
if (not $col) {
unless ($args->{class}) {
$args->{class} = ref $self || $self;
@@ -671,14 +734,15 @@ sub _to_select {
if not $args->{selected} and ref $self;
}
$col = $args->{class}->primary_column;
+ $args->{name} ||= $col;
}
# Related Class maybe ?
- elsif (my $rel_meta = $self->related_meta('r:)', $col) ) {
+ elsif ($rel_meta = $self->related_meta('r:)', $col) ) {
$args->{class} = $rel_meta->{foreign_class};
# 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
@@ -686,7 +750,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;
@@ -709,11 +774,10 @@ sub _to_select {
}
# We could say :Col is name and we are selecting out of class arg.
# DIE for now
- else {
- #$args->{name} = $col;
- die "Usage _to_select. $col not related to any class to select from. ";
+ #else {
+ # die "Usage _to_select. $col not related to any class to select from. ";
- }
+ #}
# Set arguments
unless ( defined $args->{column_nullable} ) {
@@ -722,10 +786,18 @@ 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});
+ my $items = _select_items($args); # array of hashrefs
+
+ # Turn items into objects if related
+ if ($rel_meta and not $args->{no_construct}) {
+ my @objs = ();
+ push @objs, $rel_meta->{foreign_class}->construct($_) foreach @$items;
+ $args->{items} = \@objs;
+ }
+ else { $args->{items} = $items; }
+
+ #use Data::Dumper;
+ #warn "Just got items. They are " . Dumper($args->{items});
# Make select HTML element
$a = $self->_select_guts($col, $args);
@@ -752,7 +824,7 @@ sub _list_intersect {
############
# FUNCTION #
############
-# Get Items
+# Get Items returns array of hashrefs
sub _select_items {
my $args = shift;
my $fclass = $args->{class};
@@ -777,9 +849,13 @@ 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);
+ my $sth = $fclass->db_Main->prepare($sql);
+ $sth->execute;
+ my @data;
+ while ( my $d = $sth->fetchrow_hashref ) {push @data, $d};
+ return \@data;
}
@@ -787,30 +863,23 @@ sub _select_items {
# 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;
}
=head2 _to_enum_select
-$sel_box = $self->_to_enum_select($column, "ENUM('Val1','Val2','Val3')");
-
-Returns an enum select box given a column name and an enum string.
-NOTE: The Plugin::Type does not return an enum string for mysql enum columns.
-This will not work unless you write your own column_type method in your model.
+Returns a select box for the an enum column type.
=cut
@@ -822,11 +891,9 @@ sub _to_enum_select {
my @enum_vals = split /\s*,\s*/, $enum;
# determine which is pre selected --
- # if obj, the value is , otherwise use column_default which is the first
- # value in the enum list unless it has been overridden
my $selected = eval { $self->$col };
- $selected = eval{$self->column_default($col)} unless defined $selected;
- $selected = $enum_vals[0] unless defined $selected;
+ $selected = $args->{default} unless defined $selected;
+ $selected = $enum_vals[0] unless defined $selected;
my $a = HTML::Element->new("select", name => $col);
for ( @enum_vals ) {
@@ -842,19 +909,12 @@ sub _to_enum_select {
=head2 _to_bool_select
- my $sel = $self->_to_bool_select($column, $bool_string);
-
-This makes select input for boolean column. You can provide a
-bool string of form: Bool('zero','one') and those are used for option
-content. Onthervise No and Yes are used.
-TODO -- test without bool string.
+Returns a "No/Yes" select box for a boolean column type.
=cut
-
# TCODO fix this mess with args
sub _to_bool_select {
my ($self, $col, $args) = @_;
- #warn "In to_bool select\n";
my $type = $args->{column_type};
my @bool_text = ('No', 'Yes');
if ($type =~ /BOOL\((.+?)\)/i) {
@@ -862,11 +922,11 @@ sub _to_bool_select {
@bool_text = split /,/, $bool;
}
- # get selectedod
+ # get selected
my $selected = $args->{value} if defined $args->{value};
$selected = $args->{selected} unless defined $selected;
- $selected = ref $self ? eval {$self->$col;} : $self->column_default($col)
+ $selected = ref $self ? eval {$self->$col;} : $args->{default}
unless (defined $selected);
my $a = HTML::Element->new("select", name => $col);
@@ -890,34 +950,30 @@ sub _to_bool_select {
}
-=head2 _to_hidden($col, $args)
+=head2 _to_hidden($field, $args)
-This makes a hidden html element. Give it a name and value or if name is
-a ref it will use the PK name and value of the object.
+This makes a hidden html element input. It uses the "name" and "value"
+arguments. If one or both are not there, it will look for an object in
+"items->[0]" or the caller. Then it will use $field or the primary key for
+name and the value of the column by the derived name.
=cut
sub _to_hidden {
- my ($self, $name, $val) = @_;
- my $args = {};
- my $obj;
- if (ref $name and $name->isa("Class::DBI")) {
- $obj = $name;
- $name= ($obj->primary_columns)[0]->name;
- }
- if (ref $val) {
- $args = $val;
- $val = $args->{value};
- $name = $args->{name} if $args->{name};
- }
- elsif (not $name ) { # hidding object caller
- $self->_croak("No object available in _to_hidden") unless ref $self;
- $name = ($self->primary_column)[0]->name;
- $val = $self->id;
- }
+ my ($self, $field, $args) = @_;
+ $args ||= {};
+ my ($name, $value) = ($args->{'name'}, $args->{value});
+ $name = $field unless defined $name;
+ if (! defined $name and !defined $value) { # check for objects
+ my $obj = $args->{items}->[0] || $self;
+ unless (ref $obj) { die "_to_hidden cannot determine a value. It was passed a value argument or items object or called with an object."; }
+ $name = $obj->primary_column->name unless $name;
+ $value = $obj->$name unless $value;
+ }
+
return HTML::Element->new('input', 'type' => 'hidden',
- 'name' => $name, 'value'=>$val
- );
+ 'name' => $name, 'value'=>$value);
+
}
=head2 _to_link_hidden($col, $args)
@@ -940,42 +996,36 @@ 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;
my $a = HTML::Element->new('a', 'href' => $href);
$a->push_content("$obj");
- $a->push_content($self->_to_hidden($name, $obj->id));
+ $a->push_content($self->to_field('blahfooey', 'hidden', {name => $name, value => $obj->id} ));
+
$OLD_STYLE && return $a->as_HTML;
$a;
}
-
-
=head2 _to_foreign_inputs
-$html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]);
+Creates inputs for a foreign class, usually related to the calling class or
+object. In names them so they do not clash with other names and so they
+can be processed generically. See _rename_foreign_inputs below and
+Maypole::Model::CDBI::FromCGI::classify_foreign_inputs.
-Get inputs for the accessor's class. Pass an array ref of fields to get
-inputs for only those fields. Otherwise display_columns or all columns is used.
-If you have the meta info handy for the accessor you can pass that too.
+Arguments this recognizes are :
-TODO make AsForm know more about the request like what action we are doing
-so it can use edit columns or search_columns
-
-NOTE , this names the foreign inputs is a particular way so they can be
-processed with a general routine and so there are not name clashes.
-
-args -
-related_meta -- if you have this, great, othervise it will determine or die
-columns -- list of columns to make inputs for
+ related_meta -- if you have this, great, othervise it will determine or die
+ columns -- list of columns to make inputs for
+ request (r) -- TODO the Maypole request so we can see what action
=cut
@@ -996,7 +1046,9 @@ sub _to_foreign_inputs {
}
# Ignore our fkey in them to prevent infinite recursion
- my $me = eval {$rel_meta->{args}{foreign_column}} || '';
+ my $me = eval {$rel_meta->{args}{foreign_key}} ||
+ eval {$rel_meta->{args}{foreign_column}}
+ || ''; # what uses foreign_column has_many or might_have
my $constrained = $rel_meta->{args}{constraint};
my %inputs;
foreach ( @$fields ) {
@@ -1007,7 +1059,8 @@ sub _to_foreign_inputs {
# Make hidden inputs for constrained columns unless we are editing object
# TODO -- is this right thing to do?
unless (ref $classORobj || $args->{no_hidden_constraints}) {
- $inputs{$_} = $classORobj->_to_hidden($_, $constrained->{$_})
+ $inputs{$_} = $classORobj->to_field('blahfooey', 'hidden',
+ {name => $_, value => $constrained->{$_}} )
foreach ( keys %$constrained );
}
$self->_rename_foreign_input($accssr, \%inputs);
@@ -1017,17 +1070,20 @@ sub _to_foreign_inputs {
=head2 _hash_selected
-Method to make sense out of the "selected" argument which can be in a number
-of formats perhaps. It returns a hashref with the the values of options to be
-as the keys.
+*Function* to make sense out of the "selected" argument which has values of the
+options that should be selected by default when making a select box. It
+can be in a number formats. This method returns a map of which options to
+select with the values being the keys in the map ( {val1 => 1, val2 = 1} ).
-Below handles these formats for the "selected" slot in the arguments hash:
- Object (with id method)
- Scalar (assumes it is value)
- Array ref *OF* objects, arrays of data (0 elmnt used), hashes of data
- (id key used), and simple scalars.
-
+Currently this method handles the following formats for the "selected" argument
+and in the following ways
+ Object -- uses the id method to get the value
+ Scalar -- assumes it *is* the value
+ Array ref of objects -- same as Object
+ Arrays of data -- uses the 0th element in each
+ Hashes of data -- uses key named 'id'
+
=cut
############
@@ -1036,12 +1092,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) {
@@ -1080,12 +1139,16 @@ sub _hash_selected {
=head2 _select_guts
-Internal api method to make the actual select box form elements.
+Internal api method to make the actual select box form elements.
+the data.
-3 types of lists making for --
+Items to make options out of can be
+ 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
@@ -1094,6 +1157,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);
@@ -1106,42 +1170,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) = @_;
@@ -1149,8 +1230,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;
@@ -1168,8 +1251,9 @@ 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)) ?
@@ -1181,20 +1265,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} || {};
@@ -1202,33 +1307,37 @@ sub _options_from_hashes {
my $fclass = $args->{class} || '';
my $stringify = $args->{stringify} || '';
my @res;
- for (@$items) {
- my $val = $_->{$pk};
- my $opt = HTML::Element->new("option", value => $val );
+ for my $item (@$items) {
+ my $val = defined $item->{$pk} ? $item->{$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) ?
+ my $content = ($fclass and $stringify and $fclass->can($stringify)) ?
$fclass->$stringify($_) :
- join(' ', @$_);
+ join(' ', map {$item->{$_} } keys %$item);
$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);
+#}
+
+=head2 _to_checkbox
+
+Makes a checkbox element -- TODO
+
+=cut
#
# 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
@@ -1241,7 +1350,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);
@@ -1249,7 +1357,11 @@ sub _to_checkbox {
return $a;
}
+=head2 _to_radio
+Makes a radio button element -- TODO
+
+=cut
# TODO -- make this general radio butons
#
sub _to_radio {
@@ -1280,52 +1392,49 @@ 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. This is important
+to avoid name clashes as well as automating processing of forms.
+
+=cut
+
+sub foreign_input_delimiter { '__AF__' };
+
=head2 _box($value)
This functions computes the dimensions of a textarea based on the value
@@ -1333,9 +1442,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;
@@ -1362,6 +1472,8 @@ sub _box
=head1 CHANGES
+1.0
+15-07-2004 -- Initial version
=head1 MAINTAINER
Maypole Developers