X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FAsForm.pm;h=f1fe978b1c36e7273f883d54a364cda003ec97ae;hb=c3973978e1373a262d13da63c9e9ecfde4b72cc7;hp=da295789b8902354d6a13e8441d7c00596a5ba16;hpb=72ee4cbcfbb971c12dc6bd6d540edf96692061ca;p=maypole.git diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm index da29578..f1fe978 100644 --- a/lib/Maypole/Model/CDBI/AsForm.pm +++ b/lib/Maypole/Model/CDBI/AsForm.pm @@ -1,6 +1,16 @@ package Maypole::Model::CDBI::AsForm; -use 5.006; +#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 strict; use warnings; @@ -9,26 +19,22 @@ use base 'Exporter'; use Data::Dumper; use Class::DBI::Plugin::Type (); use HTML::Element; +use Carp qw/cluck/; our $OLD_STYLE = 0; # pjs -- Added new methods to @EXPORT -our @EXPORT = qw( to_cgi to_field _to_textarea _to_textfield _to_select - type_of _to_foreign_inputs _to_enum_select _to_bool_select - to_select_from_many _to_select_from_related hasmany_class - _to_hidden _rename_foreign_input _to_readonly - make_param_foreign make_hidden_elmnt make_hidden_elmnt - a_select_box unselect_element do_select search_inputs); - - - -our $VERSION = '2.41'; -# PJS VERSION .05 -# Changes : -# 08-09-05 - fixed broken has_a select box -# - fiked some docs -# - _to_foreign_inputs now takes 3 positional parameters -# (accssr, fields, accssr_meta_info) - +our @EXPORT = + qw( + 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_array _options_from_hash + ); + +our $VERSION = '.10'; =head1 NAME @@ -43,22 +49,43 @@ Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns ... sub create_or_edit { - my $class = shift; - my %cgi_field = $class->to_cgi; + my $self = shift; + my %cgi_field = $self->to_cgi; return start_form, (map { "$_: ". $cgi_field{$_}->as_HTML."
" } $class->Columns), end_form; } - #
- # Title:
- # Artist: - # ... - #
+# 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", + } +); + +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'); + + =head1 DESCRIPTION @@ -69,330 +96,711 @@ into textareas, and fields with a has-a relationship to other C tables are turned into select drop-downs populated with objects from the joined class. -=head1 METHODS -The module is a mix-in which adds two additional methods to your -C-derived class. +=head1 ARGUMENTS HASH +This provides a convenient way to tweak AsForm's behavior in exceptional or +not so exceptional instances. Below describes the arguments hash and +example usages. -=head2 search_inputs -Returns hashref of search inputs elements to use in cgi. + $beer->to_field($col, $how, $args); + $beer->to_field($col, $args); -Uses fields specified in search_fields, makes foreign inputs if necessary. +Not all _to_* methods pay attention to all arguments. For example, '_to_textfield' does not look in $args->{'items'} at all. + +=over -=cut +=item name -- the name the element will have , this trumps the derived name. -sub search_inputs { - my ($class, $r) = @_; - warn "In model search_inputs " if $class->model_debug; - $class = ref $class || $class; - #my $accssr_class = { $class->accessor_classes }; - my %cgi; - my $sfs = $class->search_fields; - - foreach my $field ( @$sfs ) { - if ( ref $field eq "HASH" ) { # foreign search fields - my ($accssr, $cols) = each %$field; - unless ( @$cols ) { - # default to search fields for related - #$cols = $accssr_class->{$accssr}->search_fields; - die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'"); - } - my $fcgi = $class->_to_foreign_inputs($accssr, $cols); - # unset the default values for a select box - foreach (keys %$fcgi) { - $class->unselect_element($fcgi->{$_}); - } - $cgi{$accssr} = $fcgi; - #warn "Searchy inputs for field $field is " . Dumper($cgi{$accssr}); - } else { - $cgi{$field} = $class->to_field($field); - $class->unselect_element($cgi{$field}); - } - } - return \%cgi; -} + $beer->to_field('brewery', 'readonly', { + 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 -=head2 do_select +Can be array of objects, hashes, arrays, or strings, or just a hash. -Retrieves object selected from a select box and puts in $r->objects[0]. -The select box input must be named the same as the primary key. + # 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') ], + }); -NOTE only works with tables with single primary key for now. + # Make a select for a boolean field + $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] }); -=cut +=item selected -- something representing which item is selected in a select box -sub do_select { - my ($self, $r) = @_; - $r->objects([ $self->retrieve($r->params->{$self->primary_column}) ]); - $r->template('view'); -} + $beer->to_field('brewery', { + selected => $beer->brewery, # again not necessary since caller is obj. + }); +Can be an simple scalar id, an object, or an array of either -=head2 unselect_element +=item class -- the class for which the input being made for field pertains to. -Unselects all options in a HTML::Element of type select. -It does nothing if element is not a select element. +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, + }); -=cut +=item column_type -- a string representing column type + + $pub->to_field('open', 'bool_select', { + column_type => "bool('Closed', 'Open'), + }); -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'); - } - } -} +=item column_nullable -- flag saying if column is nullable or not +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 }); -# make a select box from args -sub a_select_box { - my ($self, $name, $vals, $selected_val, $contents) = @_; - die "Usage: Need a name and array ref of values to make a select boxes" unless ($name && $vals); - $selected_val ||= ""; - $contents ||= $vals ; - - my $a = HTML::Element->new('select', 'name' => $name); - my $i = 0; - my $c; - foreach my $v ( @$vals ) { - my $opt = HTML::Element->new('option', 'value' => $v); - $opt->attr('selected' => 'selected') if $v eq $selected_val; - $c = $contents->[$i++] || $v; - $opt->push_content($c); - $a->push_content($opt); - } - $a; -} +=item r or request -- the mapyole request object +=item uri -- uri for a link , used in methods such as _to_link_hidden -=head2 make_hidden_elmnt + $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 -Makes a hidden HTML::Element and puts it in template_args{hidden_elements} -$model->make_hidden_elmnt($name, $val); +=item order_by, constraint, join -=cut +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. + + BeerDB::LondonBeer->has_a('brewery', 'BeerDB::Brewery', + 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 . -sub make_hidden_elmnt { - my ($self, $r, $col, $val) = @_; - my $elmnt = HTML::Element->new('input', 'type'=>'hidden', 'name'=>$col, 'value'=>$val); +=back - $r->{template_args}{hidden_elements} ||= []; - push @{ $r->{template_args}{hidden_elements} }, $elmnt; +=head2 to_cgi + + $self->to_cgi([@columns, $args]); + +This returns a hash mapping all the column names to HTML::Element objects +representing form widgets. It takes two opitonal arguments -- a list of +columns and a hashref of hashes of arguments for each column. If called with an object like for editing, the inputs will have the object's values. + + $self->to_cgi(); # uses $self->columns; # most used + $self->to_cgi(qw/brewery style rating/); # sometimes + # and on rare occassions this is desireable if you have a lot of fields + # 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 + }, + 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; + # 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. All that you need +is a method named "_to_$how" in your class. Your class inherits many from +AsForm already. Override them at will. -=head2 make_param_foreign +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. +See C. You can also pass this argument in $args->{how}. -Makes a new foreign parameter out of parameter and accessor -Just puts accssr__FOREIGN__ in front of param name =cut -sub make_param_foreign { - my ($self, $r, $p, $accssr) = @_; - $r->params->{$accssr . '__FOREIGN__' . $p} = $r->params->{$p}; +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); + + + 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 to_cgi +=head2 search_inputs -This returns a hash mapping all the column names of the class to -HTML::Element objects representing form widgets. + my $cgi = $class->search_inputs ([$args]); # optional $args + +Returns hash or hashref of search inputs elements for a class making sure the +inputs are empty of any initial values. +You can specify what columns you want inputs for in +$args->{columns} or +by the method "search_columns". The default is "display_columns". +If you want to te search on columns in related classes you can do that by +specifying a one element hashref in place of the column name where +the key is the related "column" (has_a or has_many method for example) and +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'] } ); + } -pjs -- added a columns list argument to specify which columns to make -inputs for. + # Now foreign inputs are made for Brewery name and location and the + # there will be no name clashing and processing can be automated. =cut -sub to_cgi { - my ($class, @columns) = @_; # pjs -- added columns arg - @columns = $class->columns unless (@columns); - map { $_ => $class->to_field($_) } @columns; + +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')); + } + } + } + } + return \%cgi; } -=head2 to_field($field [, $how]) -This maps an individual column to a form element. The C argument -can be used to force the field type into one of C, C