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;
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 make_element_foreign unselect_element
+ to_cgi to_field make_element_foreign search_inputs unselect_element
_field_from_how _field_from_relationship _field_from_column
- _to_textarea _to_textfield _to_select _select_guts
+ _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
+ _options_from_scalars _to_select_or_create
);
-
-our @EXPORTOK =
- qw(
-
-
- );
-
-
-
-our $VERSION = '.09';
-# 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)
-
-# 10-18-05 - made _to_enum_select check column_default
-# 10-19-05 - exported _to_select_from_objs
-# - Now VERSION .06
-# 10-24-05 - _to_select_from_many Redesign.
-# Now first arg is either a has_many accessor or a array ref of
-# objects to select from and the options are in named list .
-# selected : object or id
-# name : the element name
-# to_select_from_many ($accssr|$objs [, selected => $obj|$id, name => $elmnt_name])
-#
-# - _to_hidden -- if object arg then name and value are from pk
-# _ _rename_foreign_input -- took out useless assignment on new name
-# - _to_select : put empty option if column is nullable
-# 11-04-05 - _to_readonly with no args makes the calling object pk and id
-# - _to_select : if object calls it without a column argument, it make# s a select box of the calling class rows and the object is pre selected.
-#
-# 11-05-05 - added _to_link_hidden to make a link to the hidden object
-# - fixed _to_hidden when called with no args. Hides self obj.
-# 11-04-05 - _to_textfield: tries to call "deflate4edit" if column is has_a
-# 11-08-05 - Changed Version to .08
-
-
-
-# 1-10-06 -- fixed bug in to_textfiled that was stringifyingf CDBI objects
-# #
-#
-# 1-20-06 - to_select - call db_Main with has a class.
-# 1-24-06 - to_select_from_many now named _to_select_from_many . Old deprecated
-# - hasmany_class removed in favor of model's related_class method.
-# - took out do_select. That is a model action.
-# - use search_columns instead of search_fields now.
-# - use to_field('column', 'select', {args}) instead of a_select_box.
-# -- took out make_hidden_element.was my own personal hack
-# -- added _box from DH's FormView to calculate decent textarea size
-# -- Refactor to_field into _from_* method calls.
-#
-# 1-25-06 -- Added _to_checkbox and _to_radio from FView
-# 1-27-06 -- Refactored into yet more exported methods
-# 1-28-06 -- select constraints where, join order by
-# 2-16-05 -- select box cols should only contain pks if you want them to
-# be in he content string of the option. Went backt to old way.
-#
+our $VERSION = '.09';
=head1 NAME
end_form;
}
- . . . somewhere use to_field($col, $how, $args)
- package BeerDB::Pint;
- __PACKAGE__->has_a('drinker', 'BeerDB::Drinker');
- __PACKAGE__->has_a('beer', 'BeerDB::Beer');
-
- package BeerDB::Drinker;
- __PACKAGE__->has_many('pints', 'BeerDB::Pint');
-
-
- # NOTE NEED to do mapping
-
- # Order a round -- multiple select of all pints if class method
- my $sel = BeerDB::Drinker->to_field('pints', 'select') #
-
- # Take one down pass it around
- my $choice = $Drunk->to_field('pints', 'select'); # Choose from what we already have
-
-
-package Job;
-
-__PACKAGE__->has_a('employer' => 'Employer');
-__PACKAGE__->has_a('contact' => 'Contact')
+ # Example of has_many select
-package Contact;
+ package Job;
+ __PACKAGE__->has_a('job_employer' => 'Employer');
+ __PACKAGE__->has_a('contact' => 'Contact')
-__PACKAGE__->has_a('employer_also' => 'Employer');
-__PACKAGE__->has_many('jobs' => 'Job',
- { join => { employer => 'employer_also' },
+ 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',
-);
-
-
- # Below gives select boxes with the multiple attribute.
- my $select_jobs_for_new_contact =
- Contact->to_field('jobs', 'select'); # Uses constraint and order by
-
- my $edit_jobs_for_existing_contact =
- $contact->to_field('jobs', 'select');
+ );
+ # Choose some jobs to add to a contact (has multiple attribute).
+ my $job_sel = Contact->to_field('jobs'); # Uses constraint and order by
- # Random uses
-
+ # Choose a job from $contact->jobs
+ my $job_sel = $contact->to_field('jobs');
=head1 DESCRIPTION
C<Class::DBI> 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<Class::DBI>-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.
+ $beer->to_field($col, $how, $args);
+ $beer->to_field($col, $args);
-=head2 unselect_element
+Not all _to_* methods pay attention to all arguments. For example, '_to_textfield' does not look in $args->{'items'} at all.
+
+=item name -- the name the element will have , this trumps the derived name.
-Unselects all options in a HTML::Element of type select.
-It does nothing if element is not a select element.
+ $beer->to_field('brewery', 'readonly', {
+ name => 'brewery_id'
+ });
+
+=item value -- the initial value the element will have, trumps derived value
-=cut
+ $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
-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');
- }
- }
-}
+Can be array of objects, hashes, arrays, or strings, or just a hash.
+ # 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') ],
+ });
-=head2 a_select_box
+ # Make a select for a boolean field
+ $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] });
- Returns a HTML::Element representing a select box, based on the arguments
+=item selected -- something representing which item is selected in a select box
-=cut
+ $beer->to_field('brewery', {
+ selected => $beer->brewery, # again not necessary since caller is obj.
+ });
-# 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;
-}
+Can be an simple scalar id, an object, or an array of either
+=item class -- the class for which the input being made for field pertains to.
+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,
+ });
-=head2 to_cgi
+=item column_type -- a string representing column type
+
+ $pub->to_field('open', 'bool_select', {
+ column_type => "bool('Closed', 'Open'),
+ });
+
+=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 });
+
+=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});
+ # an html link that is also a hidden input to the object. R is required to
+ # make the uri unless you pass a uri
+
+=item order_by, constraint, join
+
+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.
-This returns a hash mapping all the column names of the class to
-HTML::Element objects representing form widgets.
+ 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 --
-pjs -- added a columns list argument to specify which columns to make
-inputs for.
+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]);
+
+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 = ref $columns[-1] ? pop @columns : {};
+ use Data::Dumper;
+ warn "Args are " . Dumper($args);
@columns = $class->columns unless (@columns);
- map { $_ => $class->to_field($_) } @columns;
+ map { $_ => $class->to_field($_, $args->{$_}) } @columns;
}
-
-=head2 to_field($field [, $how])
+=head2 to_field($field [, $how][, $args])
This maps an individual column to a form element. The C<how> argument
-can be used to force the field type into one of C<textfield>, C<textarea>
-or C<select>; you can use this is you want to avoid the automatic detection
-of has-a relationships.
+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".
+If C<how> 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<HOW Methods>. You can also pass this argument in $args->{how}.
-# pjs
- -- added support for enum and bool. Note for enum and bool you need
- a better column_type method than the Plugin::Type ' s as it won't work
- if you are using MySQL. I have not tried others.
- See those method's docs below.
- -- Foreign inputs for might_have, must_have, has_own, and has_many(i think).
- -- Really any relationship except has_a and is_a as has_a gets a select box
- and is_a are not considered foreign.
- -- Note a good column_type sub can be
- used to get the correct type for is_a columns.
- -- More efficient _to_select -- no object creation.
- -- Attempts to set default value in field for you using a "column_default"
- method you write yourself or your CDBI driver like mysql writes.
- -- _to_hidden
=cut
sub to_field {
- my ($self, $field, @args) = @_;
- my $how = shift @args unless ref $args[0];
+ 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 $args = shift @args; # argument hash ref
- use Data::Dumper;
+=head2 search_inputs
+
+ my $cgi = $class->search_inputs ([$args]); # optional $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);
+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'] } );
+ }
+
+ # 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 search_inputs {
+ my ($class, $args) = @_;
+ warn "In new Search Inputs";
+ $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) {
+ #$class->unselect_element($fcgi->{$_});
+ }
+ $cgi{$accssr} = $fcgi;
+ delete $base_args->{columns};
+ } else {
+ $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$field} });
+ #$class->unselect_element($cgi{$field});
+ }
+ }
+ return \%cgi;
+}
+
+
+
+#
+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');
+ }
+ }
}
=head2 _field_from_how($field, $how,$args)
sub _field_from_how {
my ($self, $field, $how, $args) = @_;
- $args ||= '';
-# warn "field is $field. how is $how. args are $args";
+ if (ref $how) { $args = $how; $how = undef; }
+ return unless $how;
+ $args ||= {};
no strict 'refs';
- my $meth = $how ? "_to_$how" : '' ;
-# warn "Meth is $meth. field is $field";
- return $self->$meth($field, $args) if $meth and $self->can($meth);
+ my $meth = "_to_$how";
+ if (not $self->can($meth)) {
+ warn "Class can not $meth";
+ return;
+ }
+ return $self->$meth($field, $args);
return;
}
sub _field_from_relationship {
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;
- $args->{class} = $fclass;
my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0;
# maybe has_a select
-# warn "Dumper of relmeta. " . Dumper($rel_meta);
+ #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);
+ }
+ 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})
+ {
+ $args->{class} = $fclass;
+ $args->{items} = $self->$field;
return $self->_to_select($field, $args);
}
return;
=cut
sub _field_from_column {
- my ($self, $field, $args) = @_;
- 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)
- 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_textfield {
my ($self, $col, $args ) = @_;
$args ||= {};
- my $val = $args->{value};
+ my $val = $args->{value};
my $name = $args->{name} || $col;
unless (defined $val) {
# Case where column inflates.
# Input would get stringification which could be not good.
# as in the case of Time::Piece objects
- $val = $self->$col;
+ $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} ) {
+ #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..";
+ #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";
+ #warn "No meta for $col but ref $val.\n";
$val = $val->id if $val->isa("Class::DBI");
}
}
$val = '' unless defined $val;
}
}
- my $a = HTML::Element->new("input", type => "text", name => $name);
- $a->attr("value" => $val);
+ my $a = HTML::Element->new("input", type => "text", name => $name, value =>
+ $val);
+
$OLD_STYLE && return $a->as_HTML;
$a;
}
my ($self, $col, $args) = @_;
$args ||= {};
# Do we have items already ? Go no further.
- if ($args->{items}) {
+ if ($args->{items} and @{$args->{items}}) {
my $a = $self->_select_guts($col, $args);
$OLD_STYLE && return $a->as_HTML;
+ if ($args->{multiple}) { $a->attr('multiple', 'multiple');}
return $a;
}
# No Column parameter -- means making a select box of args->class or self
# Using all rows from class's table
if (not $col) {
- warn "No col. $self";
unless ($args->{class}) {
$args->{class} = ref $self || $self;
# object selected if called with one
}
else {
$args->{selected} ||= [ $self->$col ] if ref $self;
-# warn "selected is " . Dumper($args->{selected});
+ #warn "selected is " . Dumper($args->{selected});
my $c = $rel_meta->{args}{constraint} || {};
my $j = $rel_meta->{args}{join} || {};
my @join ;
}
# Set arguments
- if ( $self->can('column_nullable') ) {
- $args->{nullable} ||= $self->column_nullable($col);
+ unless ( defined $args->{column_nullable} ) {
+ $args->{column_nullable} = $self->can('column_nullable') ?
+ $self->column_nullable($col) : 1;
}
# Get items to select from
$args->{items} = _select_items($args);
-# warn "Items selecting from are " . Dumper($args->{items});
+ #warn "Items selecting from 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);
+ if ($args->{multiple}) {$a->attr('multiple', 'multiple');}
+
# Return
$OLD_STYLE && return $a->as_HTML;
$a;
sub _select_items {
my $args = shift;
my $fclass = $args->{class};
- my @disp_cols;
- @disp_cols = $fclass->columns('SelectBox');
+ my @disp_cols = @{$args->{columns} || []};
+ @disp_cols = $fclass->columns('SelectBox') unless @disp_cols;
@disp_cols = $fclass->columns('Stringify')unless @disp_cols;
@disp_cols = $fclass->_essential unless @disp_cols;
unshift @disp_cols, $fclass->columns('Primary');
#foreach (@pks) { push @sel_cols, $_ unless $isect{$_}; }
#push @sel_cols, @disp_cols;
+ warn "in select items. args are : " . Dumper($args);
+ my $distinct = '';
+ if ($args->{'distinct'}) {
+ $distinct = 'DISTINCT ';
+ }
- my $sql = "SELECT " . join( ', ', @disp_cols) .
+ my $sql = "SELECT $distinct" . join( ', ', @disp_cols) .
" FROM " . $fclass->table;
$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);
=cut
+# TCODO fix this mess with args
sub _to_bool_select {
- my ($self, $col, $type) = @_;
+ my ($self, $col, $args) = @_;
+ warn "In to_bool select";
+ my $type = $args->{column_type};
my @bool_text = ('No', 'Yes');
if ($type =~ /BOOL\((.+?)\)/i) {
(my $bool = $1) =~ s/'//g;
@bool_text = split /,/, $bool;
}
- my $one= ref $self ? eval {$self->$col;} : $self->column_default($col);
+
+ # get selectedod
+
+ my $selected = $args->{value} if defined $args->{value};
+ $selected = $args->{selected} unless defined $selected;
+ $selected = ref $self ? eval {$self->$col;} : $self->column_default($col)
+ unless (defined $selected);
+
my $a = HTML::Element->new("select", name => $col);
+ if ($args->{column_nullable} || $args->{value} eq '') {
+ my $null = HTML::Element->new("option");
+ $null->attr('selected', 'selected') if $args->{value} eq '';
+ $a->push_content( $null );
+ }
+
my ($opt0, $opt1) = ( HTML::Element->new("option", value => 0),
HTML::Element->new("option", value => 1) );
- $opt0->attr("selected" => "selected") if not $one;
$opt0->push_content($bool_text[0]);
- $opt1->attr("selected" => "selected") if $one;
$opt1->push_content($bool_text[1]);
+ unless ($selected eq '') {
+ $opt0->attr("selected" => "selected") if not $selected;
+ $opt1->attr("selected" => "selected") if $selected;
+ }
$a->push_content($opt0, $opt1);
$OLD_STYLE && return $a->as_HTML;
$a;
sub _to_link_hidden {
my ($self, $accessor, $args) = @_;
- my $r = $args->{r} || '';
- my $url = $args->{url} || '';
+ my $r = eval {$self->controller} || $args->{r} || '';
+ my $uri = $args->{uri} || '';
use Data::Dumper;
-# warn "$self Args are " . Dumper($args);
- $self->_croak("_to_link_hidden called without Maypole Request object (\$r) and url. Need one or other.")
+ $self->_croak("_to_link_hidden cant get uri. No Maypole Request class (\$r) or uri arg. Need one or other.")
unless $r;
my ($obj, $name);
if (ref $self) { # hidding linking self
$obj = $self;
$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
+ }
+
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
}
$self->_croak("_to_link_hidden has no object") unless ref $obj;
- my $href = $url || $r->config->{uri_base} . "/". $obj->table."/view/".$obj->id;
+ 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));
############
sub _hash_selected {
my ($args) = shift;
- my $selected = $args->{selected};
+ my $selected = $args->{value} || $args->{selected};
return $selected unless $selected and ref $selected ne 'HASH';
+ warn "Selected dump : " . Dumper($selected);
my $type = ref $selected;
# Single Object
if ($type and $type ne 'ARRAY') {
elsif (not $type) {
return { $selected => 1};
}
+
# Array of objs, arrays, hashes, or just scalalrs.
elsif ($type eq 'ARRAY') {
else { warn "AsForm Could not hash the selected argument: $selected"; }
}
-
=head2 _select_guts
Internal api method to make the actual select box form elements.
=cut
+
sub _select_guts {
my ($self, $col, $args) = @_; #$nullable, $selected_id, $values) = @_;
- $args->{stringify} ||= 'stringify_selectbox';
- $args->{selected} = _hash_selected($args);
+ #$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);
$a->attr( %{$args->{attr}} ) if $args->{attr};
- if ($args->{nullable}) {
- my $null_element = HTML::Element->new('option');
+ if ($args->{column_nullable}) {
+ my $null_element = HTML::Element->new('option', value => '');
$null_element->attr(selected => 'selected')
if ($args->{selected}{'null'});
- $null_element->push_content('-- choose or type --');
$a->push_content($null_element);
}
for (@$items) {
my $opt = HTML::Element->new("option", value => $_->id);
$opt->attr(selected => "selected") if $selected->{$_->id};
- my $content = $stringify ? $_->$stringify : "$_";
+ my $content = $stringify ? $_->stringify : "$_";
$opt->push_content($content);
push @res, $opt;
}
my $class = $args->{class} || '';
my $stringify = $args->{stringify} || '';
for my $item (@$items) {
- my @pks;
+ my @pks; # for future multiple key support
push @pks, shift @$item foreach $class->columns('Primary');
- my $id = $pks[0] + 0; # In case zerofill is on .
+ my $id = $pks[0];
+ $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} );
}
sub _options_from_hashes {
- my ($self, $items, $args) = @_;
- my $selected = $args->{selected} || {};
- my $pk = eval {$args->{class}->primary_column} || 'id';
- my $fclass = $args->{class} || '';
- my $stringify = $args->{stringify} || '';
- my @res;
- for (@$items) {
- my $val = $_->{$pk};
- my $opt = HTML::Element->new("option", value => $val );
- $opt->attr(selected => "selected") if $selected->{$val};
- my $content = ($fclass && $stringify && $fclass->can($stringify)) ?
- $fclass->$stringify($_) :
- join(' ', @$_);
- $opt->push_content( $content );
- push (@res, $opt);
- }
- return @res;
+ my ($self, $items, $args) = @_;
+ my $selected = $args->{selected} || {};
+ my $pk = eval {$args->{class}->primary_column} || 'id';
+ my $fclass = $args->{class} || '';
+ my $stringify = $args->{stringify} || '';
+ my @res;
+ for (@$items) {
+ 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(' ', @$_);
+ $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);
+}
+
#
# 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
1;
-
=head1 CHANGES
-=head1 MAINTAINER
+
+=head1 MAINTAINER
Maypole Developers
-=head1 ORIGINAL AUTHOR
+=head1 AUTHORS
+
+Peter Speltz, Aaron Trevena
-Peter Speltz, Aaron Trevena
+=head1 AUTHORS EMERITUS
+
+Simon Cozens, Tony Bowden
=head1 TODO
=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 / Tony Bowden
+Copyright 2003-2004 by Simon Cozens and Tony Bowden
+Copyright 2005-2006 by Aaron Trevena and Peter Speltz
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
L<Class::DBI>, L<Class::DBI::FromCGI>, L<HTML::Element>.
=cut
-
-
-
-
projects / maypole.git / commitdiff