# -- $class->to_field($has_many_col); # foreign inputs
# $class->search_inputs; /
-
+use Class::C3;
use strict;
+
use warnings;
use base 'Exporter';
use Carp qw/cluck/;
our $OLD_STYLE = 0;
-# pjs -- Added new methods to @EXPORT
our @EXPORT =
qw(
to_cgi to_field foreign_input_delimiter search_inputs unselect_element
_options_from_array _options_from_hash
);
-our $VERSION = '.95';
+our $VERSION = '.96';
=head1 NAME
=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";
- # 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;
- }
- }
-
-
+ 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);
}
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'));
- }
- }
+ 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;
+ }
+ $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;
}
=cut
sub _field_from_column {
- 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 ($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;
}