# -- $class->to_field($has_many_col); # foreign inputs
# $class->search_inputs; /
+
use strict;
use warnings;
# 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_array _options_from_hash _to_select_or_create
+ _options_from_array _options_from_hash
);
-our $VERSION = '.10';
+our $VERSION = '.10';
=head1 NAME
$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'
});
-
+
=item value -- the initial value the element will have, trumps derived value
$beer->to_field('brewery', 'textfield', {
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
my ($class, @columns) = @_; # pjs -- added columns arg
my $args = {};
if (not @columns) {
- @columns = $class->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; }
=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 any you want. It tells AsForm how
-to make the input ie-- forces it to use the method "_to_$how".
+can be used to force the field type into any you want. All that you need
+is a method named "_to_$how" in your class. Your class inherits many from
+AsForm already. Override them at will.
+
If C<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.
}
+
+
=head2 unselect_element
- unselect any selected elemets in a HTML::Element select list widget
+ unselect any selected elements in a HTML::Element select list widget
=cut
-
-#
sub unselect_element {
my ($self, $el) = @_;
#unless (ref $el eq 'HTML::Element') {
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';
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 $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})
if (not $rel_meta->{args}{no_select} and not $args->{no_select})
{
$args->{class} = $fclass;
- $args->{items} = $self->$field;
+ my @itms = $self->$field; # need list not iterator
+ $args->{items} = \@itms;
return $self->_to_select($field, $args);
}
return;
}
return;
}
-
-
+
=head2 _field_from_column($field, $args)
Returns an input based on the column's characteristics, namely type, or nothing.
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);
}
my $type = $args->{column_type};
return $self->_to_textfield($field, $args)
- if $type and $type =~ /(VAR)?CHAR/i; #common type
+ 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)
sub _to_textfield {
my ($self, $col, $args ) = @_;
+ use Carp qw/confess/;
+ confess "No col passed to _to_textfield" unless $col;
$args ||= {};
my $val = $args->{value};
my $name = $args->{name} || $col;
$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;
}
}
}
else {
- #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, value =>
- $val);
-
+ my $a;
+ # THIS If section is neccessary or you end up with "value" for a vaiue
+ # if val is
+ $val = '' unless defined $val;
+ $a = HTML::Element->new("input", type => "text", name => $name, value =>$val);
$OLD_STYLE && return $a->as_HTML;
$a;
}
sub _to_select {
my ($self, $col, $args) = @_;
$args ||= {};
-# Do we have items already ? Go no further.
+ # 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;
return $a;
}
-# Else what are we making a select box out of ?
+ # Else what are we making a select box out of ?
# No Column parameter -- means making a select box of args->class or self
# Using all rows from class's table
if (not $col) {
# 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
# 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;
# Get items to select from
$args->{items} = _select_items($args);
- #warn "Items selecting from are " . Dumper($args->{items});
-#use Data::Dumper;
-#warn "Just got items. They are " . Dumper($args->{items});
+ #use Data::Dumper;
+ #warn "Just got items. They are " . Dumper($args->{items});
# Make select HTML element
$a = $self->_select_guts($col, $args);
$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);
# 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;
}
# 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) {
$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;
$a;
}
-
-
=head2 _to_foreign_inputs
$html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]);
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) {
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);
my $items = $args->{items};
my $type = ref $items;
my $proto = eval { ref $items->[0]; } || "";
- warn "Type is $type, proto is $proto\n";
+ 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
- if ($type eq 'HASH') {
+ elsif ($type eq 'HASH') {
$a->push_content($self->_options_from_hash($items, $args));
}
# Single Array
}
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) = @_;
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;
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)) ?
my $selected = $args->{selected} || {};
my @res;
for (@$items) {
- my $opt = HTML::Element->new("option", value => $_ );
+ 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( $_ );
my @values = values %$items;
# hash Key is the option content and the hash value is option value
for (sort keys %$items) {
- my $opt = HTML::Element->new("option", value => $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( $_ );
my $stringify = $args->{stringify} || '';
my @res;
for (@$items) {
- my $val = $_->{$pk};
- my $opt = HTML::Element->new("option", value => $val );
+ my $val = defined $_->{$pk} ? $_->{$pk} : '';
+ my $opt = HTML::Element->new("option", value => $val);
$opt->attr(selected => "selected") if $selected->{$val};
my $content = ($fclass and $stringify and $fclass->can($stringify)) ?
$fclass->$stringify($_) :
return @res;
}
-sub _to_select_or_create {
- my ($self, $col, $args) = @_;
- $args->{name} ||= $col;
- my $select = $self->to_field($col, 'select', $args);
- $args->{name} = "create_" . $args->{name};
- my $create = $self->to_field($col, 'foreign_inputs', $args);
- $create->{'__select_or_create__'} =
- $self->to_field('__select_or_create__',{ name => '__select_or_create__' , value => 1 } );
- return ($select, $create);
-}
-
+# TODO -- Maybe
+#sub _to_select_or_create {
+# my ($self, $col, $args) = @_;
+# $args->{name} ||= $col;
+# my $select = $self->to_field($col, 'select', $args);
+# $args->{name} = "create_" . $args->{name};
+# my $create = $self->to_field($col, 'foreign_inputs', $args);
+# $create->{'__select_or_create__'} =
+# $self->to_field('__select_or_create__',{ name => '__select_or_create__' , value => 1 } );
+# return ($select, $create);
+#}
+
#
# checkboxes: if no data in hand (ie called as class method), replace
# with a radio button, in order to allow this field to be left
_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->{$_})
}
}
-=head2 _box($value)
+=head2 foreign_input_delimiter
+
+This tells AsForm what to use to delmit forieign_input names with. The name has the form -- $foreign_accessor. $DELIMITER . $foreign_column
+
+=cut
+
+sub foreign_input_delimiter { '__AF__' };
+
+=head2 _box($value)
This functions computes the dimensions of a textarea based on the value
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;
projects / maypole.git / blobdiff