X-Git-Url: https://git.decadent.org.uk/gitweb/?a=blobdiff_plain;f=lib%2FMaypole%2FModel%2FCDBI%2FAsForm.pm;h=f176f3ec9a86c2994835fff66e1ea6ff870d91d5;hb=ce828f4b7309670fc8b0ed826fd2455c4d5412bb;hp=2c5f60df019b7f82d0475a861ca277486a87b10e;hpb=1abc072646e8d37a20ee85c8ca6bb548e2176027;p=maypole.git
diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index 2c5f60d..f176f3e 100644
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -7,8 +7,9 @@ package Maypole::Model::CDBI::AsForm;
# -- $class->to_field($has_many_col); # foreign inputs
# $class->search_inputs; /
-
+use Class::C3;
use strict;
+
use warnings;
use base 'Exporter';
@@ -18,7 +19,6 @@ use HTML::Element;
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
@@ -30,7 +30,7 @@ our @EXPORT =
_options_from_array _options_from_hash
);
-our $VERSION = '.95';
+our $VERSION = '.96';
=head1 NAME
@@ -53,25 +53,95 @@ Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns
end_form;
}
-# 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",
- }
-);
+ . . .
+
+ # Somewhere else in a Maypole application about beer...
+
+
+
+
+ $beer->to_field('brewery', 'textfield', {
+ name => 'brewery_id', value => $beer->brewery,
+ # however, no need to set value since $beer is object
+ });
+
+ # 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') ],
+ });
+
+ # Make a select for a boolean field
+ $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] });
+
+ $beer->to_field('brewery', {
+ selected => $beer->brewery, # again not necessary since caller is obj.
+ });
+
+
+ $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
+
+
+
+ #####################################################
+ # Templates Usage
+
+
-package Employer;
-__PACKAGE__->has_many('jobs' => 'Job',);
-__PACKAGE__->has_many('contacts' => 'Contact',
- order_by => 'name DESC',
-);
+
+ #####################################################
+ # Advanced Usage
+
+ # 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).
@@ -81,6 +151,9 @@ __PACKAGE__->has_many('contacts' => 'Contact',
# Choose a job from $contact->jobs
my $job_sel = $contact->to_field('jobs');
+ 1;
+
+
=head1 DESCRIPTION
@@ -242,7 +315,7 @@ sub to_cgi {
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.
+AsForm already.
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.
@@ -253,26 +326,24 @@ See C. You can also pass this argument in $args->{how}.
=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
- unless ($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);
}
@@ -302,65 +373,64 @@ Example:
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;
}
@@ -445,18 +515,6 @@ sub _field_from_relationship {
return;
}
-
-
- #NOOO! maybe select from has_many
-# if ($rel_type eq 'has_many' and ref $self) {
-# $args->{items} ||= [$self->$field];
-# # arg name || fclass pk name || field
-# if (not $args->{name}) {
-# $args->{name} = eval{$fclass->primary_column->name} || $field;
-# }
-# return $self->_to_select($field, $args);
-# }
- #
# maybe foreign inputs
my %local_cols = map { $_ => 1 } $self->columns; # includes is_a cols
if ($fclass_is_cdbi and (not $local_cols{$field} or $rel_name eq 'has_own'))
@@ -475,38 +533,43 @@ Override at will.
=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 $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;
}
sub _to_textarea {
my ($self, $col, $args) = @_;
+ my $class = $args->{class} || $self;
+ $class = ref $class || $class;
+ $col ||= ($class->primary_columns)[0]; # TODO
# pjs added default
$args ||= {};
my $val = $args->{value};
@@ -671,6 +734,7 @@ sub _to_select {
if not $args->{selected} and ref $self;
}
$col = $args->{class}->primary_column;
+ $args->{name} ||= $col;
}
# Related Class maybe ?
elsif ($rel_meta = $self->related_meta('r:)', $col) ) {
@@ -710,11 +774,10 @@ sub _to_select {
}
# We could say :Col is name and we are selecting out of class arg.
# DIE for now
- else {
- #$args->{name} = $col;
- die "Usage _to_select. $col not related to any class to select from. ";
+ #else {
+ # die "Usage _to_select. $col not related to any class to select from. ";
- }
+ #}
# Set arguments
unless ( defined $args->{column_nullable} ) {
@@ -1244,13 +1307,13 @@ sub _options_from_hashes {
my $fclass = $args->{class} || '';
my $stringify = $args->{stringify} || '';
my @res;
- for (@$items) {
- my $val = defined $_->{$pk} ? $_->{$pk} : '';
+ for my $item (@$items) {
+ my $val = defined $item->{$pk} ? $item->{$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(' ', keys %$_);
+ join(' ', map {$item->{$_} } keys %$item);
$opt->push_content( $content );
push @res, $opt;
}