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
_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 _to_select_or_create
+ _options_from_array _options_from_hash _to_select_or_create
);
-our $VERSION = '.09';
+our $VERSION = '.10';
=head1 NAME
end_form;
}
- # Example of has_many select
+# Example of has_many select
+package Job;
+__PACKAGE__->has_a('job_employer' => 'Employer');
+__PACKAGE__->has_a('contact' => 'Contact')
- 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
$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
this sometimes when making foreign inputs .
+=back
+
=head2 to_cgi
$self->to_cgi([@columns, $args]);
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;
}
=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
sub search_inputs {
my ($class, $args) = @_;
- warn "In new Search Inputs";
$class = ref $class || $class;
#my $accssr_class = { $class->accessor_classes };
my %cgi;
# 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;
}
+=head2 unselect_element
+
+ unselect any selected elemets in a HTML::Element select list widget
+
+=cut
#
sub unselect_element {
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';
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};
return;
}
+
=head2 _field_from_column($field, $args)
Returns an input based on the column's characteristics, namely type, or nothing.
=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;
}
my ($self, $col, $args) = @_;
$args ||= {};
# Do we have items already ? Go no further.
- if ($args->{items} and @{$args->{items}}) {
+ if ($args->{items} and ref $args->{items}) {
my $a = $self->_select_guts($col, $args);
$OLD_STYLE && return $a->as_HTML;
if ($args->{multiple}) { $a->attr('multiple', 'multiple');}
#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 ';
$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
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;
$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 => $_);
# 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) {
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') {
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.
3 types of lists making for --
+ Hash, Array,
Array of CDBI objects.
Array of scalars ,
- Array or Array refs with cols from class.
+ Array or Array refs with cols from class,
+ Array of hashes
=cut
$a->push_content($null_element);
}
- my $items = $args->{items};
- my $proto = $items->[0];
- my $type = ref $proto || '';
-
- # Objects
- if (not $type) {
- $a->push_content($self->_options_from_scalars($items, $args));
- }
- elsif($type !~ /ARRAY|HASH/i) {
- # make select of objects
- $a->push_content($self->_options_from_objects($items, $args));
- }
- elsif ($type =~ /ARRAY/i) {
- $a->push_content($self->_options_from_arrays($items, $args));
+ my $items = $args->{items};
+ my $type = ref $items;
+ my $proto = eval { ref $items->[0]; } || "";
+ warn "Type is $type, proto is $proto\n";
+ # Single Hash
+ if ($type eq 'HASH') {
+ $a->push_content($self->_options_from_hash($items, $args));
+ }
+ # Single Array
+ elsif ( $type eq 'ARRAY' and not ref $items->[0] ) {
+ $a->push_content($self->_options_from_array($items, $args));
+ }
+ # Array of Objects
+ elsif( $type eq 'ARRAY' and $proto !~ /ARRAY|HASH/i ) {
+ # make select of objects
+ $a->push_content($self->_options_from_objects($items, $args));
+ }
+ # Array of Arrays
+ elsif ( $type eq 'ARRAY' and $proto eq 'ARRAY' ) {
+ $a->push_content($self->_options_from_arrays($items, $args));
}
- elsif ($type =~ /HASH/i) {
- $a->push_content($self->_options_from_hashes($items, $args));
+ # Array of Hashes
+ elsif ( $type eq 'ARRAY' and $proto eq 'HASH' ) {
+ $a->push_content($self->_options_from_hashes($items, $args));
}
- else {
- die "You passed a weird type of data structure to me. Here it is: $type";
+ else {
+ die "You passed a weird type of data structure to me. Here it is: " .
+ Dumper($items );
}
return $a;
}
-
-
-
-
-
-
=head2 _options_from_objects ( $objects, $args);
Private method to makes a options out of objects. It attempts to call each
$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} );
return @res;
}
-sub _options_from_scalars {
+
+sub _options_from_array {
my ($self, $items, $args) = @_;
- my $selected = $args->{selected} || {};
+ my $selected = $args->{selected} || {};
my @res;
- for (@$items) {
- my $opt = HTML::Element->new("option", value => $_ );
- #$opt->attr(selected => "selected") if $selected =~/^$id$/;
- $opt->attr(selected => "selected") if $selected->{$_};
- $opt->push_content( $_ );
- push @res, $opt;
+ for (@$items) {
+ my $opt = HTML::Element->new("option", value => $_ );
+ #$opt->attr(selected => "selected") if $selected =~/^$id$/;
+ $opt->attr(selected => "selected") if $selected->{$_};
+ $opt->push_content( $_ );
+ push @res, $opt;
}
return @res;
}
+sub _options_from_hash {
+ my ($self, $items, $args) = @_;
+ my $selected = $args->{selected} || {};
+ my @res;
+
+ 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->{$_} );
+ #$opt->attr(selected => "selected") if $selected =~/^$id$/;
+ $opt->attr(selected => "selected") if $selected->{$items->{$_}};
+ $opt->push_content( $_ );
+ push @res, $opt;
+ }
+ return @res;
+}
+
+
sub _options_from_hashes {
my ($self, $items, $args) = @_;
my $selected = $args->{selected} || {};
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(' ', @$_);
+ $fclass->$stringify($_) :
+ join(' ', @$_);
$opt->push_content( $content );
push @res, $opt;
}
sub _to_checkbox {
my ($self, $col, $args) = @_;
my $nullable = eval {self->column_nullable($col)} || 0;
-
return $self->_to_radio($col) if !ref($self) || $nullable;
my $value = $self->$col;
my $a = HTML::Element->new("input", type=> "checkbox", name => $col);
foreach (keys %$element);
}
}
-=head2 _box($value)
+
+=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 $text = shift;
1;
-=head1 CHANGES
+=head1 CHANGES
-=head1 MAINTAINER
+=head1 MAINTAINER
Maypole Developers
=head1 AUTHORS
-Peter Speltz, Aaron Trevena
+Peter Speltz, Aaron Trevena
=head1 AUTHORS EMERITUS
=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.
L<Class::DBI>, L<Class::DBI::FromCGI>, L<HTML::Element>.
=cut
+
projects / maypole.git / blobdiff