From 446373ada20165687d0c3b03a2ee18c08831be02 Mon Sep 17 00:00:00 2001 From: biopete Date: Fri, 7 Apr 2006 14:31:00 +0000 Subject: [PATCH] AsForm bug fixes -- to_cgi args, to_enum_select , search_inputs adds blank field correctly (mostly :) ). macros -- try to call " accessor_name_for" before cdbi deprecated "accessor_name" git-svn-id: http://svn.maypole.perl.org/Maypole/trunk@471 48953598-375a-da11-a14b-00016c27c3ee --- lib/Maypole/Model/CDBI/AsForm.pm | 217 +++++++++++++++++---------- lib/Maypole/templates/factory/macros | 9 +- 2 files changed, 144 insertions(+), 82 deletions(-) diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index 70a7eb4..ef67a06 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -11,6 +11,8 @@ package Maypole::Model::CDBI::AsForm; # -- $class->to_field($has_many_col); # foreign inputs # $class->search_inputs; / +use 5.006; + use strict; use warnings; @@ -21,6 +23,7 @@ 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 @@ -31,8 +34,16 @@ our @EXPORT = _options_from_objects _options_from_arrays _options_from_hashes _options_from_scalars _to_select_or_create ); + +our @EXPORTOK = + qw( + + + ); + + -our $VERSION = '.09'; +our $VERSION = '.10'; =head1 NAME @@ -55,33 +66,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 @@ -193,6 +205,7 @@ 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 . + =head2 to_cgi $self->to_cgi([@columns, $args]); @@ -220,10 +233,13 @@ 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; + } + else { + if ( ref $columns[-1] eq 'HASH' ) { $args = pop @columns; } + } map { $_ => $class->to_field($_, $args->{$_}) } @columns; } @@ -241,14 +257,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 +301,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 +325,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; @@ -338,7 +384,8 @@ Override at will. sub _field_from_how { my ($self, $field, $how, $args) = @_; - if (ref $how) { $args = $how; $how = undef; } + #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'; @@ -362,6 +409,7 @@ For has_a it will give select box 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}; @@ -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,35 @@ 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; + #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 $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; } @@ -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); @@ -764,7 +815,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 +828,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 +854,7 @@ TODO -- test without bool string. # TCODO fix this mess with args sub _to_bool_select { my ($self, $col, $args) = @_; - warn "In to_bool select"; + #warn "In to_bool select\n"; my $type = $args->{column_type}; my @bool_text = ('No', 'Yes'); if ($type =~ /BOOL\((.+?)\)/i) { @@ -986,7 +1037,7 @@ 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 dump : " . Dumper($selected); my $type = ref $selected; # Single Object if ($type and $type ne 'ARRAY') { @@ -1022,9 +1073,12 @@ 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. @@ -1032,7 +1086,6 @@ Internal api method to make the actual select box form elements. Array of CDBI objects. Array of scalars , Array or Array refs with cols from class. - =cut @@ -1118,7 +1171,7 @@ sub _options_from_arrays { $id =~ ~ s/^0+//; # In case zerofill is on . my $opt = HTML::Element->new("option", value => $id ); $opt->attr(selected => "selected") if $selected->{$id}; - + my $content = ($class and $stringify and $class->can($stringify)) ? $class->$stringify($_) : join( '/', map { $_ if $_; }@{$item} ); @@ -1153,8 +1206,9 @@ sub _options_from_hashes { my $val = $_->{$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(' ', @$_); + my $content = $fclass and $stringify and $fclass->can($stringify) ? + $fclass->$stringify($_) : + join(' ', @$_); $opt->push_content( $content ); push @res, $opt; } @@ -1169,9 +1223,12 @@ sub _to_select_or_create { 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 @@ -1302,16 +1359,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 +1388,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 +1402,4 @@ it under the same terms as Perl itself. L, L, L. =cut + diff --git a/lib/Maypole/templates/factory/macros b/lib/Maypole/templates/factory/macros index cbf58bb..53f6952 100644 --- a/lib/Maypole/templates/factory/macros +++ b/lib/Maypole/templates/factory/macros @@ -56,15 +56,20 @@ for some. [% MACRO display_line(item) BLOCK; FOR col = classmetadata.list_columns; NEXT IF col == "id" OR col == classmetadata.table _ "_id"; + col_obj = item.find_column(col); ""; IF col == "url" AND item.url; ' '; item.url; ''; ELSIF col == classmetadata.stringify_column; maybe_link_view(item); - ELSE; - accessor = item.accessor_name(col); + ELSIF col_obj; # its a real column + accessor = item.accessor_name_for(col_obj) || + item.accessor_name(col_obj); # deprecated in cdbi maybe_link_view(item.$accessor); + ELSE; + item.$col; END; + ""; END; ''; -- 2.39.2