our $OLD_STYLE = 0;
# pjs -- Added new methods to @EXPORT
-our @EXPORT =
- qw(
- to_cgi to_field _to_textarea _to_textfield _to_select
+our @EXPORT =
+ qw(
+ to_cgi to_field make_element_foreign 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_select_from_many _to_select_from_related _to_select_from_objs
_to_hidden _to_link_hidden _rename_foreign_input _to_readonly
_options_from_objects _options_from_arrays _options_from_hashes
_options_from_scalars
- _field_from_how _field_from_relationship _field_from_column
- _select_guts unselect_element search_inputs make_param_foreign
);
+
+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 = '2.11';
=head1 NAME
package BeerDB::Pint;
__PACKAGE__->has_a('drinker', 'BeerDB::Drinker');
__PACKAGE__->has_a('beer', 'BeerDB::Beer');
+
package BeerDB::Drinker;
__PACKAGE__->has_many('pints', 'BeerDB::Pint');
-
- # NEED to do mapping
- my $sel = BeerDB::Drinker->to_field('pints', 'select') # multiple
- my $sel = $Drunk->to_field('pints', 'select'); # Already had beers selected
+
+
+ # 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;
- # Random uses
+ # Random uses
+
=head1 DESCRIPTION
C<Class::DBI>-derived class.
-=head2 search_inputs
-
-Returns hashref of search inputs elements to use in cgi.
-
-Uses fields specified in search_fields, makes foreign inputs if necessary.
-
-=cut
-
-# TODO -- use search_columns
-
-sub search_inputs {
- my ($class, $r) = @_;
- warn "In model search_inputs " if $class->model_debug;
- $class = ref $class || $class;
- #my $accssr_class = { $class->accessor_classes };
- my %cgi;
- my $sfs = [$class->search_columns];
-
- foreach my $field ( @$sfs ) {
- if ( ref $field eq "HASH" ) { # foreign search fields
- my ($accssr, $cols) = each %$field;
- 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_foreign_inputs($accssr, $cols);
- # unset the default values for a select box
- foreach (keys %$fcgi) {
- $class->unselect_element($fcgi->{$_});
- }
- $cgi{$accssr} = $fcgi;
- } else {
- $cgi{$field} = $class->to_field($field);
- $class->unselect_element($cgi{$field});
- }
- }
- return \%cgi;
-}
-
=head2 unselect_element
}
-=head2 a_select_box
-
- Returns a HTML::Element representing a select box, based on the arguments
-
-=cut
-
# make a select box from args
sub a_select_box {
my ($self, $name, $vals, $selected_val, $contents) = @_;
-=head2 make_param_foreign
-
-Makes a new foreign parameter out of parameter and accessor
-Just puts accssr__FOREIGN__ in front of param name
-
-=cut
-
-sub make_param_foreign {
- my ($self, $r, $p, $accssr) = @_;
- $r->params->{$accssr . '__FOREIGN__' . $p} = $r->params->{$p};
-}
-
=head2 to_cgi
This returns a hash mapping all the column names of the class to
sub to_field {
my ($self, $field, @args) = @_;
my $how = shift @args unless ref $args[0];
+
my $args = shift @args; # argument hash ref
+ use Data::Dumper;
+ warn "args to_field are $field, " . Dumper(\@args);
return $self->_field_from_how($field, $how, $args) ||
$self->_field_from_relationship($field, $args) ||
sub _field_from_how {
my ($self, $field, $how, $args) = @_;
- if ($how) {
- no strict 'refs';
- my $meth = "_to_$how";
- return $self->$meth($field, $args) if $self->can($meth);
- }
+ $args ||= '';
+ warn "field is $field. how is $how. args are $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);
return;
}
Returns an input based on the relationship associated with the field or nothing.
Override at will.
+For has_a it will give select box
+
=cut
sub _field_from_relationship {
my ($self, $field, $args) = @_;
- my $meta = $self->meta_info;
- my ($rel_type) = grep{ defined $meta->{$_}{$field} } keys %$meta;
- $rel_type ||= '';
- my $fclass = $rel_type ? $meta->{$rel_type}{$field}{foreign_class} : '';
+ 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
- return $self->_to_select($field, $args)
- if $rel_type eq 'has_a' and $fclass_is_cdbi;
+ 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})
+ {
+ return $self->_to_select($field, $args);
+ }
+ 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_type eq 'has_own'))
+ if ($fclass_is_cdbi and (not $local_cols{$field} or $rel_name eq 'has_own'))
{
- return $self->_to_foreign_inputs($field, undef, $meta->{$rel_type}{$field});
+ $args->{related_meta} = $rel_meta; # suspect faster to set these args
+ return $self->_to_foreign_inputs($field, $args);
}
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) = @_;
- 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) = @_;
+ 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)
+ 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;
}
$val = $self->$col;
if (ref $val) {
if (my $meta = $self->related_meta('',$col)) {
+ warn "Meta for $col";
if (my $code = $meta->{args}{deflate4edit} ) {
$val = ref $code ? &$code($val) : $val->$code;
}
+ elsif ( $val->isa('Class::DBI') ) {
+ $val = $val->id;
+ }
else {
- $val = $self->_attr($col);
+ warn "No deflate4edit code defined for $val of type " .
+ ref $val . ". Using the stringified value in textfield..";
}
}
else {
- $val = $self->_attr($col);
+ warn "No meta for $col but ref $val.\n";
+ $val = $val->id if $val->isa("Class::DBI");
}
}
$col = $args->{class}->primary_column;
}
# Related Class maybe ?
- elsif (my ($rel_type, $rel_meta) = $self->related_meta('r:)', $col) ) {
+ elsif (my $rel_meta = $self->related_meta('r:)', $col) ) {
$args->{class} = $rel_meta->{foreign_class};
# related objects pre selected if object
- $args->{selected} ||= [ $self->$col ] if ref $self;
- # "Has many" -- we get multiple select
- if ($rel_type =~ /has_many/i) {
- $args->{attr}{multiple} = 'multiple';
- # TODO -- handle mapping
+ # "Has many" -- Issues:
+ # 1) want to select one 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
+ # example.
+
+ # Hasmany select one from list if ref self
+ if ($rel_meta->{name} =~ /has_many/i and ref $self) {
+ $args->{items} = [ $self->$col ];
+ my $a = $self->_select_guts($col, $args);
+ $OLD_STYLE && return $a->as_HTML;
+ return $a;
}
- my $c = $rel_meta->{args}{constraint} || {};
- my $j = $rel_meta->{args}{join} || {};
- my @join ;
- if (ref $self) {
- @join = map { $_ ." = ". $self->_attr($_) } keys %$j;
+ else {
+ $args->{selected} ||= [ $self->$col ] if ref $self;
+ warn "selected is " . Dumper($args->{selected});
+ my $c = $rel_meta->{args}{constraint} || {};
+ my $j = $rel_meta->{args}{join} || {};
+ my @join ;
+ if (ref $self) {
+ @join = map { $_ ." = ". $self->_attr($_) } keys %$j;
+ }
+ my @constr= map { "$_ = '$c->{$_}'"} keys %$c;
+ $args->{where} ||= join (' AND ', (@join, @constr));
+ $args->{order_by} ||= $rel_meta->{args}{order_by};
+ $args->{limit} ||= $rel_meta->{args}{limit};
}
- my @constr= map { "$_ = '$c->{$_}'"} keys %$c;
- $args->{where} ||= join (' AND ', (@join, @constr));
- $args->{order_by} ||= $rel_meta->{args}{order_by};
- $args->{limit} ||= $rel_meta->{args}{limit};
}
# We could say :Col is name and we are selecting out of class arg.
# Get items to select from
$args->{items} = _select_items($args);
- # Make select HTML element
- $a = $self->_select_guts($col, $args);
+ warn "Items selecting from are " . Dumper($args->{items});
+#use Data::Dumper;
+#warn "Just got items. They are " . Dumper($args->{items});
- # Return
+ # Make select HTML element
+ $a = $self->_select_guts($col, $args);
+
+ # Return
$OLD_STYLE && return $a->as_HTML;
$a;
}
-
+
+##############
+# Function #
+# #############
+# returns the intersection of list refs a and b
+sub _list_intersect {
+ my ($a, $b) = @_;
+ my %isect; my %union;
+ foreach my $e (@$a, @$b) { $union{$e}++ && $isect{$e}++ }
+ return %isect;
+}
############
# FUNCTION #
############
sub _select_items {
my $args = shift;
my $fclass = $args->{class};
- my @select_box_cols;
- @select_box_cols = $fclass->columns('SelectBox');
- @select_box_cols = $fclass->columns('Stringify')
- unless @select_box_cols;
- @select_box_cols = $fclass->_essential
- unless @select_box_cols;
- unshift @select_box_cols, $fclass->columns('Primary')
- unless $select_box_cols[0] eq $fclass->columns('Primary');
-
- my $sql = "SELECT " . join( ', ', @select_box_cols) .
+ my @disp_cols;
+ @disp_cols = $fclass->columns('SelectBox');
+ @disp_cols = $fclass->columns('Stringify')unless @disp_cols;
+ @disp_cols = $fclass->_essential unless @disp_cols;
+ unshift @disp_cols, $fclass->columns('Primary');
+ #my %isect = _list_intersect(\@pks, \@disp_cols);
+ #foreach (@pks) { push @sel_cols, $_ unless $isect{$_}; }
+ #push @sel_cols, @disp_cols;
+
+
+ my $sql = "SELECT " . 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";
return $fclass->db_Main->selectall_arrayref($sql);
my ($self, $accessor, $args) = @_;
my $r = $args->{r} || '';
my $url = $args->{url} || '';
-
+ 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.")
unless $r;
my ($obj, $name);
NOTE , this names the foreign inputs is a particular way so they can be
processed with a general routine and so there are not name clashes.
+args -
+related_meta -- if you have this, great, othervise it will determine or die
+columns -- list of columns to make inputs for
+
=cut
sub _to_foreign_inputs {
- my ($self, $accssr, $fields, $accssr_meta) = @_;
- if (!$accssr_meta) {
- my $class_meta = $self->meta_info;
- my ($rel_type) = grep { defined $class_meta->{$_}->{$accssr} }
- keys %$class_meta;
- $self->_croak( "No relationship for accessor $accssr") if not $rel_type;
- $accssr_meta = $class_meta->{$rel_type}->{$accssr};
+ my ($self, $accssr, $args) = @_;
+ my $rel_meta = $args->{related_meta} || $self->related_meta('r',$accssr);
+ my $fields = $args->{columns};
+ if (!$rel_meta) {
+ $self->_croak( "No relationship for accessor $accssr");
}
- my $classORobj = ref $self && ref $self->$accssr ? $self->$accssr : $accssr_meta->{foreign_class};
+ my $rel_type = $rel_meta->{name};
+ my $classORobj = ref $self && ref $self->$accssr ? $self->$accssr : $rel_meta->{foreign_class};
unless ($fields) {
$fields = $classORobj->can('display_columns') ?
}
# Ignore our fkey in them to prevent infinite recursion
- my $me = eval {$accssr_meta->{args}{foreign_column}} || '';
- my $constrained = $accssr_meta->{args}{constraint};
+ my $me = eval {$rel_meta->{args}{foreign_column}} || '';
+ my $constrained = $rel_meta->{args}{constraint};
my %inputs;
foreach ( @$fields ) {
next if $constrained->{$_} || ($_ eq $me); # don't display constrained
# Make hidden inputs for constrained columns unless we are editing object
# TODO -- is this right thing to do?
- unless (ref $classORobj) {
+ unless (ref $classORobj || $args->{no_hidden_constraints}) {
$inputs{$_} = $classORobj->_to_hidden($_, $constrained->{$_})
foreach ( keys %$constrained );
}
if ($args->{nullable}) {
my $null_element = HTML::Element->new('option');
$null_element->attr(selected => 'selected')
- if $args->{selected}{'null'};
+ if ($args->{selected}{'null'});
$null_element->push_content('-- choose or type --');
$a->push_content($null_element);
}
my $type = ref $proto || '';
# Objects
- if ($type and $type !~ /ARRAY|HASH/i) {
+ 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));
}
$a->push_content($self->_options_from_hashes($items, $args));
}
else {
- $a->push_content($self->_options_from_scalars($items, $args));
+ die "You passed a weird type of data structure to me. Here it is: $type";
}
return $a;
my ($self, $items, $args) = @_;
my $selected = $args->{selected} || {};
my @res;
- my $fclass = $args->{class} || '';
+ my $class = $args->{class} || '';
my $stringify = $args->{stringify} || '';
- for (@$items) {
- my $id = $_->[0];
+ for my $item (@$items) {
+ my @pks;
+ push @pks, shift @$item foreach $class->columns('Primary');
+ my $id = $pks[0] + 0; # In case zerofill is on .
my $opt = HTML::Element->new("option", value => $id );
- #$opt->attr(selected => "selected") if $selected =~/^$id$/;
$opt->attr(selected => "selected") if $selected->{$id};
- my $content = ($fclass and $stringify and $fclass->can($stringify)) ?
- $fclass->$stringify($_) :
- join('/', @{$_});
-
+ my $content = ($class and $stringify and $class->can($stringify)) ?
+ $class->$stringify($_) :
+ join( '/', map { $_ if $_; }@{$item} );
$opt->push_content( $content );
push @res, $opt;
}
my $fclass = $args->{class} || '';
my $stringify = $args->{stringify} || '';
my @res;
- for my $item (@$items) {
- my $val = $item->{$pk};
+ 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($item) : join(' ', @$item);
+ my $content = $fclass and $stringify and $fclass->can($stringify) ?
+ $fclass->$stringify($_) :
+ join(' ', @$_);
$opt->push_content( $content );
- push @res, $opt;
+ push @res, $opt;
}
- return @res;
+ return @res;
}
#
_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
+Recursively renames the foreign inputs made by _to_foreign_inputs so they
can be processed generically. The format is "accessor__AsForeign_colname".
-So if an Employee is a Person who has own Address and you call
+So if an Employee is a Person who has_own Address and you call
Employee->to_field("person")
-then you will get inputs for Address named like this:
+then you 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__zip
And the processor would know to create this address, put the address id in
-person address slot, create the person and put the address id in the employee
-before creating the employee.
+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 :) )
=cut
+sub make_element_foreign {
+ my ($self, $accssr, $element) = @_;
+ $element->attr( name => $accssr . "__AsForeign__" . $element->attr('name'));
+}
+
+
+
sub _rename_foreign_input {
- my ($self, $accssr, $input) = @_;
- if ( ref $input ne 'HASH' ) {
+ my ($self, $accssr, $element) = @_;
+ if ( ref $element ne 'HASH' ) {
# my $new_name = $accssr . "__AsForeign__" . $input->attr('name');
- $input->attr( name => $accssr . "__AsForeign__" . $input->attr('name'));
+ $self->make_element_foreign($accssr, $element);
}
else {
- $self->_rename_foreign_input($accssr, $input->{$_})
- foreach (keys %$input);
+ $self->_rename_foreign_input($accssr, $element->{$_})
+ foreach (keys %$element);
}
}
=head2 _box($value)
=cut
+
+
+
projects / maypole.git / commitdiff