]> git.decadent.org.uk Git - maypole.git/blobdiff - lib/Maypole/Model/CDBI/AsForm.pm
projects / maypole.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Fixed FromCGI and AsForm some more. No official tests in crud.t yet but
[maypole.git] / lib / Maypole / Model / CDBI / AsForm.pm
diff --git a/lib/Maypole/Model/CDBI/AsForm.pm b/lib/Maypole/Model/CDBI/AsForm.pm
index e0cd7f21c7919388d7b42a67a3700fc5f23d7873..f1fe978b1c36e7273f883d54a364cda003ec97ae 100644 (file)
--- a/lib/Maypole/Model/CDBI/AsForm.pm
+++ b/lib/Maypole/Model/CDBI/AsForm.pm
@@ -1,6 +1,16 @@
 package Maypole::Model::CDBI::AsForm;
 
 package Maypole::Model::CDBI::AsForm;
 
-use 5.006;
+#TODO -- 
+# lots of doc
+# _to_select_or_create  -- select input stays
+# _to_create_or_select  -- create input trumps
+# 
+
+# TESTED and Works --
+#  has_many select -- $obj->to_field($has_many_col);   # select one form many
+#                  -- $class->to_field($has_many_col); # foreign inputs  
+#  $class->search_inputs; /
+
 
 use strict;
 use warnings;
 
 use strict;
 use warnings;
@@ -9,22 +19,22 @@ use base 'Exporter';
 use Data::Dumper;
 use Class::DBI::Plugin::Type ();
 use HTML::Element;
 use Data::Dumper;
 use Class::DBI::Plugin::Type ();
 use HTML::Element;
+use Carp qw/cluck/;
 
 our $OLD_STYLE = 0;
 # pjs  --  Added new methods to @EXPORT 
 
 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  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_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 
                _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 
+               _options_from_array _options_from_hash 
     );
 
     );
 
-our $VERSION = '2.11';
+our $VERSION = '.10'; 
 
 =head1 NAME
 
 
 =head1 NAME
 
@@ -47,51 +57,34 @@ Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns
                end_form;
     }
 
                end_form;
     }
 
-       . . . somewhere use to_field($col, $how, $args)
-       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
-
+# Example of has_many select
 package Job;
 package Job;
-
-__PACKAGE__->has_a('employer' => 'Employer');
+__PACKAGE__->has_a('job_employer' => 'Employer');
 __PACKAGE__->has_a('contact'  => 'Contact')
 
 package Contact;
 __PACKAGE__->has_a('contact'  => 'Contact')
 
 package Contact;
-
-__PACKAGE__->has_a('employer_also' => 'Employer');
+__PACKAGE__->has_a('cont_employer' => 'Employer');
 __PACKAGE__->has_many('jobs'  => 'Job',
 __PACKAGE__->has_many('jobs'  => 'Job',
-        { join => { employer => 'employer_also' },
+        { join => { job_employer => 'cont_employer' },
           constraint => { 'finshed' => 0  },
           order_by   => "created ASC",
         }
 );
 
 package Employer;
           constraint => { 'finshed' => 0  },
           order_by   => "created ASC",
         }
 );
 
 package Employer;
-
 __PACKAGE__->has_many('jobs'  => 'Job',);
 __PACKAGE__->has_many('contacts'  => 'Contact',
             order_by => 'name DESC',
 );
 
 
 __PACKAGE__->has_many('jobs'  => 'Job',);
 __PACKAGE__->has_many('contacts'  => 'Contact',
             order_by => 'name DESC',
 );
 
 
-  # Below gives select boxes with the multiple attribute.
-  my $select_jobs_for_new_contact =
-    Contact->to_field('jobs', 'select'); # Uses constraint and order by
-
-  my $edit_jobs_for_existing_contact =
-    $contact->to_field('jobs', 'select');
-
-
+  # Choose some jobs to add to a contact (has multiple attribute).
+  my $job_sel = Contact->to_field('jobs'); # Uses constraint and order by
+    
 
 
-       # Random uses 
-       
+  # Choose a job from $contact->jobs 
+  my $job_sel = $contact->to_field('jobs');
+    
 
 
 =head1 DESCRIPTION
 
 
 =head1 DESCRIPTION
@@ -103,158 +96,288 @@ into textareas, and fields with a has-a relationship to other
 C<Class::DBI> tables are turned into select drop-downs populated with
 objects from the joined class.
 
 C<Class::DBI> tables are turned into select drop-downs populated with
 objects from the joined class.
 
-=head1 METHODS
 
 
-The module is a mix-in which adds two additional methods to your
-C<Class::DBI>-derived class. 
+=head1 ARGUMENTS HASH
 
 
+This provides a convenient way to tweak AsForm's behavior in exceptional or 
+not so exceptional instances. Below describes the arguments hash and 
+example usages. 
 
 
-=head2 search_inputs
 
 
-Returns hashref of search inputs elements to use in cgi.
+  $beer->to_field($col, $how, $args); 
+  $beer->to_field($col, $args);
 
 
-Uses fields specified in search_fields, makes foreign inputs if necessary.
+Not all _to_* methods pay attention to all arguments. For example, '_to_textfield' does not look in $args->{'items'} at all.
+ 
+=over
 
 
-=cut
+=item name -- the name the element will have , this trumps the derived name.
 
 
-# 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;
-}
+  $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', { 
+               name => 'brewery_id', value => $beer->brewery,
+               # however, no need to set value since $beer is object
+  });
+ 
+=item items -- array of items generally used to make select box options
 
 
+Can be array of objects, hashes, arrays, or strings, or just a hash.
 
 
-=head2 unselect_element
+   # 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') ],
+   });
 
 
-Unselects all options in a HTML::Element of type select.
-It does nothing if element is not a select element.
+  # Make a select for a boolean field
+  $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] }); 
 
 
-=cut
+=item selected -- something representing which item is selected in a select box
 
 
-sub unselect_element {
-       my ($self, $el) = @_;
-       #unless (ref $el eq 'HTML::Element') { 
-       #$self->_croak ('Need an HTML::Element to unselect. You gave a ' . Dumper($el)); }
-       if ($el->tag eq 'select') {
-               foreach my $opt ($el->content_list) {
-                       $opt->attr('selected', undef) if $opt->attr('selected');
-               }
-       }
-}
+   $beer->to_field('brewery', {
+               selected => $beer->brewery, # again not necessary since caller is obj.
+   });
 
 
+Can be an simple scalar id, an object, or an array of either
 
 
-# make a select box from args
-sub a_select_box {
-       my ($self, $name, $vals, $selected_val, $contents) = @_;
-       die "Usage: Need a name and array ref of values to make a select boxes" unless ($name && $vals);
-       $selected_val ||= "";
-       $contents ||= $vals ;
-
-       my $a = HTML::Element->new('select', 'name' => $name);
-       my $i = 0;
-       my $c;
-       foreach my $v ( @$vals ) {
-               my $opt = HTML::Element->new('option', 'value' => $v);
-               $opt->attr('selected' => 'selected') if $v eq $selected_val;
-               $c = $contents->[$i++] || $v;
-               $opt->push_content($c);
-               $a->push_content($opt);
-       }
-       $a;
-}
+=item class -- the class for which the input being made for field pertains to.
 
 
+This in almost always derived in cases where it may be difficult to derive, --
+   # Select beers to serve on handpump
+   Pub->to_field(handpumps => select => {
+               class => 'Beer', order_by => 'name ASC', multiple => 1,
+       });
 
 
+=item column_type -- a string representing column type
+   
+  $pub->to_field('open', 'bool_select', {
+               column_type => "bool('Closed', 'Open'),
+  });
 
 
-=head2 make_param_foreign
+=item column_nullable -- flag saying if column is nullable or not
 
 
-Makes a new foreign parameter out of parameter and accessor
-Just puts accssr__FOREIGN__ in front of param name 
+Generally this can be set to get or not get a null/empty option added to
+a select box.  AsForm attempts to call "$class->column_nullable" to set this
+and it defaults to true if there is no shuch method.
+  
+  $beer->to_field('brewery', { column_nullable => 1 });    
 
 
-=cut
+=item r or request  -- the mapyole request object 
 
 
-sub make_param_foreign {
-       my ($self, $r, $p, $accssr) = @_;
-       $r->params->{$accssr . '__FOREIGN__' . $p} = $r->params->{$p};
-}
+=item uri -- uri for a link , used in methods such as _to_link_hidden
 
 
-=head2 to_cgi
+ $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
 
 
-This returns a hash mapping all the column names of the class to
-HTML::Element objects representing form widgets.
+=item order_by, constraint, join
 
 
-pjs -- added a columns list argument to specify which columns to make
-inputs for.
+These are used in making select boxes. order_by is a simple order by clause
+and constraint and join are hashes used to limit the rows selected. The
+difference is that join uses methods of the object and constraint uses 
+static values. You can also specify these in the relationship arguments.
+
+  BeerDB::LondonBeer->has_a('brewery', 'BeerDB::Brewery', 
+           order_by     => 'brewery_name ASC',
+          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]); 
+
+This returns a hash mapping all the column names to HTML::Element objects 
+representing form widgets.  It takes two opitonal arguments -- a list of 
+columns and a hashref of hashes of arguments for each column.  If called with an object like for editing, the inputs will have the object's values.
+
+  $self->to_cgi(); # uses $self->columns;  # most used
+  $self->to_cgi(qw/brewery style rating/); # sometimes
+  # and on rare occassions this is desireable if you have a lot of fields
+  # and dont want to call to_field a bunch of times just to tweak one or 
+  # two of them.
+  $self->to_cgi(@cols, {brewery => {  
+                                     how => 'textfield' # too big for select 
+                                                                  }, 
+                        style   => { 
+                                                            column_nullable => 0, 
+                                                            how => 'select', 
+                                                                    items => ['Ale', 'Lager']
+                                                                  }
+                                               }
 
 =cut
 
 sub to_cgi {
        my ($class, @columns) = @_; # pjs -- added columns arg
 
 =cut
 
 sub to_cgi {
        my ($class, @columns) = @_; # pjs -- added columns arg
-       @columns = $class->columns unless (@columns);
-       map { $_ => $class->to_field($_) } @columns;
+       my $args = {};
+       if (not @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; }
+       }
+       map { $_ => $class->to_field($_, $args->{$_}) } @columns;
 }
 
 }
 
-
-=head2 to_field($field [, $how])
+=head2 to_field($field [, $how][, $args])
 
 This maps an individual column to a form element. The C<how> argument
 
 This maps an individual column to a form element. The C<how> argument
-can be used to force the field type into one of C<textfield>, C<textarea>
-or C<select>; you can use this is you want to avoid the automatic detection
-of has-a relationships.
+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.
+See C<HOW Methods>. You can also pass this argument in $args->{how}.
 
 
-# pjs 
-   -- added support for enum and bool.   Note for enum and bool you need 
-      a better column_type method than the Plugin::Type ' s as it won't work 
-      if you are using MySQL. I have not tried others.  
-      See those method's docs below.
-   -- Foreign inputs for might_have, must_have, has_own, and has_many(i think).
-   -- Really any relationship except has_a and is_a as has_a gets a select box
-      and is_a are not considered foreign. 
-   -- Note a good column_type sub can be 
-      used to get the correct type for is_a columns.
-   -- More efficient _to_select -- no object creation.
-   -- Attempts to set default value in field for you using a "column_default" 
-      method you write yourself or your CDBI driver like mysql writes.
-   -- _to_hidden 
 
 =cut
 
 sub to_field {
 
 =cut
 
 sub to_field {
-       my ($self, $field, @args) = @_;
-    my $how = shift @args unless ref $args[0];  
-    my $args = shift @args;  # argument hash ref  
+       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)   || 
+       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);
 }
 
                $self->_field_from_relationship($field, $args) ||
                        $self->_field_from_column($field, $args)  ||
                        $self->_to_textfield($field, $args);
 }
 
+=head2 search_inputs
+
+  my $cgi = $class->search_inputs ([$args]); # optional $args
+
+Returns hash or hashref of search inputs elements for a class making sure the
+inputs are empty of any initial values.
+You can specify what columns you want inputs for in
+$args->{columns} or
+by the method "search_columns". The default is  "display_columns".
+If you want to te search on columns in related classes you can do that by
+specifying a one element hashref in place of the column name where
+the key is the related "column" (has_a or has_many method for example) and
+the value is a list ref of columns to search on in the related class.
+
+Example:
+  sub  BeerDB::Beer::search_columns {
+     return ( 'name' , 'rating', { brewery => [ 'name', 'location'] } );
+  }
+
+  # Now foreign inputs are made for Brewery name and location and the
+  # there will be no name clashing and processing can be automated.
+
+=cut
+
+
+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'));
+                                   }
+                               }
+                                       
+            }
+            $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;
+}
+
+
+
+
+=head2 unselect_element
+
+  unselect any selected elements in a HTML::Element select list widget
+
+=cut
+sub unselect_element {
+   my ($self, $el) = @_;
+   #unless (ref $el eq 'HTML::Element') {
+   #$self->_croak ('Need an HTML::Element to unselect. You gave a ' . Dumper($el)); }
+   if ($el->tag eq 'select') {
+       foreach my $opt ($el->content_list) {
+           $opt->attr('selected', undef) if $opt->attr('selected');
+       }
+   }
+}
+
 =head2 _field_from_how($field, $how,$args)
 
 Returns an input element based the "how" parameter or nothing at all.
 =head2 _field_from_how($field, $how,$args)
 
 Returns an input element based the "how" parameter or nothing at all.
@@ -264,11 +387,15 @@ Override at will.
 
 sub _field_from_how {
        my ($self, $field, $how, $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);
+       return unless $how;
+       $args ||= {};
+       no strict 'refs';
+       my $meth = "_to_$how";
+       if (not $self->can($meth)) { 
+               warn "Class can not $meth";
+               return;
        }
        }
+       return $self->$meth($field, $args); 
        return;
 }
 
        return;
 }
 
@@ -277,30 +404,65 @@ sub _field_from_how {
 Returns an input based on the relationship associated with the field or nothing.
 Override at will.
 
 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) = @_;
 =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} : '';
-    $args->{class} = $fclass;
+       return unless $field;
+       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;
        my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0;
 
        # maybe has_a select 
        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;
+       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}) 
+               {
+               $args->{class} = $fclass;
+               return  $self->_to_select($field, $args);
+               }
+               return;
+       }
+       # maybe has many select
+       if ($rel_meta->{name} eq 'has_many' and $fclass_is_cdbi and ref $self) {
+           # This condictions allows for trumping of the has_a args
+               if  (not $rel_meta->{args}{no_select} and not $args->{no_select}) 
+               {
+               $args->{class} = $fclass;
+                       my @itms = $self->$field; # need list not iterator
+                       $args->{items} = \@itms;
+               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
        # 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;
 }
        }
        return;
 }
-
+                       
 =head2 _field_from_column($field, $args)
 
 Returns an input based on the column's characteristics, namely type, or nothing.
 =head2 _field_from_column($field, $args)
 
 Returns an input based on the column's characteristics, namely type, or nothing.
@@ -309,31 +471,33 @@ Override at will.
 =cut
 
 sub _field_from_column {
 =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) = @_;
+       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)
-    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;
 }
 
 
 }
 
 
@@ -365,8 +529,10 @@ sub _to_textarea {
 
 sub _to_textfield {
     my ($self, $col, $args ) = @_;
 
 sub _to_textfield {
     my ($self, $col, $args ) = @_;
+    use Carp qw/confess/;
+    confess "No col passed to _to_textfield" unless $col;
     $args ||= {};
     $args ||= {};
-    my $val = $args->{value}; 
+    my $val  = $args->{value}; 
     my $name = $args->{name} || $col; 
 
     unless (defined $val) {
     my $name = $args->{name} || $col; 
 
     unless (defined $val) {
@@ -374,18 +540,22 @@ sub _to_textfield {
             # Case where column inflates.
             # Input would get stringification which could be not good.
             #  as in the case of Time::Piece objects
             # Case where column inflates.
             # Input would get stringification which could be not good.
             #  as in the case of Time::Piece objects
-            $val = $self->$col;
+            $val = $self->can($col) ? $self->$col : ''; # in case it is a virtual column
             if (ref $val) {
                                if (my $meta = $self->related_meta('',$col)) {
             if (ref $val) {
                                if (my $meta = $self->related_meta('',$col)) {
-                               if (my $code = $meta->{args}{deflate4edit} ) {
+                               if (my $code = $meta->{args}{deflate4edit} || $meta->{args}{deflate} ) {
                        $val  = ref $code ? &$code($val) : $val->$code;
                                        }
                        $val  = ref $code ? &$code($val) : $val->$code;
                                        }
+                                       elsif ( $val->isa('Class::DBI') ) {
+                                           $val  = $val->id;
+                                       }
                                        else { 
                                        else { 
-                                           $val  = $self->_attr($col);
+                                               #warn "No deflate4edit code defined for $val of type " . 
+                                            #ref $val . ". Using the stringified value in textfield..";
                                        }
                        }
                                else {
                                        }
                        }
                                else {
-                                       $val  = $self->_attr($col);
+                                       $val  = $val->id if $val->isa("Class::DBI"); 
                }
                }
                        
                }
                }
                        
@@ -395,8 +565,11 @@ sub _to_textfield {
                $val = '' unless defined $val;
         }
     }
                $val = '' unless defined $val;
         }
     }
-    my $a = HTML::Element->new("input", type => "text", name => $name);
-    $a->attr("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;
 }
     $OLD_STYLE && return $a->as_HTML;
     $a;
 }
@@ -479,18 +652,18 @@ sub _to_textfield {
 sub _to_select {
     my ($self, $col, $args) = @_;
     $args ||= {};
 sub _to_select {
     my ($self, $col, $args) = @_;
     $args ||= {};
-# Do we have items already ? Go no further. 
-    if ($args->{items}) {  
+       # 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;
                my $a = $self->_select_guts($col,  $args);
        $OLD_STYLE && return $a->as_HTML;
+               if ($args->{multiple}) { $a->attr('multiple', 'multiple');}
                return $a;
        }
 
                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) { 
        # No Column parameter --  means making a select box of args->class or self 
     # Using all rows from class's table
     if (not $col) { 
-        warn "No col. $self";
                unless ($args->{class}) {
                $args->{class} = ref $self || $self;
                        # object selected if called with one
                unless ($args->{class}) {
                $args->{class} = ref $self || $self;
                        # object selected if called with one
@@ -500,26 +673,39 @@ sub _to_select {
         $col = $args->{class}->primary_column;
     }
     # Related Class maybe ? 
         $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->{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  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
+               # example.
+
+               # Hasmany select one from list if ref self
+               if ($rel_meta->{name} =~ /has_many/i and ref $self) {
+                   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;
                }
                }
-               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.
                        
     }
     # We could say :Col is name and we are selecting  out of class arg.
@@ -531,25 +717,38 @@ sub _to_select {
     }
                
     # Set arguments 
     }
                
     # Set arguments 
-       if ( $self->can('column_nullable') ) { 
-               $args->{nullable} ||= $self->column_nullable($col);
+       unless ( defined  $args->{column_nullable} ) {
+           $args->{column_nullable} = $self->can('column_nullable') ?
+                        $self->column_nullable($col) : 1;
        }
 
        # Get items to select from
     $args->{items} = _select_items($args);
        }
 
        # Get items to select from
     $args->{items} = _select_items($args);
-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);
 
 
        # Make select HTML element
        $a = $self->_select_guts($col, $args);
 
+       if ($args->{multiple}) {$a->attr('multiple', 'multiple');}
+
        # Return 
     $OLD_STYLE && return $a->as_HTML;
     $a;
 
 }
 
        # 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 #
 ############
 ############
 # FUNCTION #
 ############
@@ -557,22 +756,28 @@ warn "Just got items. They are  " . Dumper($args->{items});
 sub _select_items { 
        my $args = shift;
        my $fclass = $args->{class};
 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 = @{$args->{columns} || []};
+    @disp_cols = $fclass->columns('SelectBox') unless @disp_cols;
+    @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;               
+
+       #warn "in select items. args are : " . Dumper($args);
+       my $distinct = '';
+       if ($args->{'distinct'}) {
+       $distinct = 'DISTINCT ';
+       }
+
+    my $sql = "SELECT $distinct" . 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};
                  " 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";
+       #warn "_select_items sql is : $sql";
 
        return $fclass->db_Main->selectall_arrayref($sql);
 
 
        return $fclass->db_Main->selectall_arrayref($sql);
 
@@ -582,19 +787,16 @@ warn "_select_items sql is : $sql";
 # Makes a readonly input box out of column's value
 # No args makes object to readonly
 sub _to_readonly {
 # 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;
     }
         $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);
     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;
 }
 
     $a;
 }
 
@@ -610,7 +812,8 @@ This will not work unless you write your own column_type method in your model.
 =cut
 
 sub _to_enum_select {
 =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;
     $type =~ /ENUM\((.*?)\)/i;
     (my $enum = $1) =~ s/'//g;
     my @enum_vals = split /\s*,\s*/, $enum;
@@ -622,7 +825,6 @@ sub _to_enum_select {
     $selected = eval{$self->column_default($col)} unless defined $selected;
     $selected = $enum_vals[0]               unless defined $selected;
 
     $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 => $_);
     my $a = HTML::Element->new("select", name => $col);
     for ( @enum_vals ) {
         my $sel = HTML::Element->new("option", value => $_);
@@ -646,21 +848,38 @@ TODO -- test without bool string.
 
 =cut
 
 
 =cut
 
+# TCODO fix this mess with args
 sub _to_bool_select {
 sub _to_bool_select {
-    my ($self, $col, $type) = @_;
+    my ($self, $col, $args) = @_;
+       my $type = $args->{column_type};
        my @bool_text = ('No', 'Yes');  
        if ($type =~ /BOOL\((.+?)\)/i) {
                (my $bool = $1) =~ s/'//g;
                @bool_text = split /,/, $bool;
        }
        my @bool_text = ('No', 'Yes');  
        if ($type =~ /BOOL\((.+?)\)/i) {
                (my $bool = $1) =~ s/'//g;
                @bool_text = split /,/, $bool;
        }
-       my $one= ref $self ? eval {$self->$col;} : $self->column_default($col);
+
+       # get selectedod 
+       
+       my $selected = $args->{value} if defined $args->{value};
+       $selected = $args->{selected} unless defined $selected;
+       $selected =  ref $self ? eval {$self->$col;} : $self->column_default($col)
+               unless (defined $selected);
+
     my $a = HTML::Element->new("select", name => $col);
     my $a = HTML::Element->new("select", name => $col);
+    if ($args->{column_nullable} || $args->{value} eq '') {
+               my $null =  HTML::Element->new("option");
+               $null->attr('selected', 'selected') if  $args->{value} eq '';
+           $a->push_content( $null ); 
+       }
+          
     my ($opt0, $opt1) = ( HTML::Element->new("option", value => 0),
                                                  HTML::Element->new("option", value => 1) ); 
     my ($opt0, $opt1) = ( HTML::Element->new("option", value => 0),
                                                  HTML::Element->new("option", value => 1) ); 
-    $opt0->attr("selected" => "selected") if not $one; 
     $opt0->push_content($bool_text[0]); 
     $opt0->push_content($bool_text[0]); 
-    $opt1->attr("selected" => "selected") if $one; 
     $opt1->push_content($bool_text[1]); 
     $opt1->push_content($bool_text[1]); 
+       unless ($selected eq '') { 
+       $opt0->attr("selected" => "selected") if not $selected; 
+       $opt1->attr("selected" => "selected") if $selected; 
+       }
     $a->push_content($opt0, $opt1);
     $OLD_STYLE && return $a->as_HTML;
     $a;
     $a->push_content($opt0, $opt1);
     $OLD_STYLE && return $a->as_HTML;
     $a;
@@ -706,22 +925,27 @@ Name defaults to the objects primary key. The object defaults to self.
 
 sub _to_link_hidden {
     my ($self, $accessor, $args) = @_;
 
 sub _to_link_hidden {
     my ($self, $accessor, $args) = @_;
-    my $r = $args->{r} || '';
-    my $url = $args->{url} || '';
-    
-    $self->_croak("_to_link_hidden called without Maypole Request object (\$r) and url. Need one or other.")
+    my $r =  eval {$self->controller} || $args->{r} || '';
+    my $uri = $args->{uri} || '';
+   use Data::Dumper;
+    $self->_croak("_to_link_hidden cant get uri. No  Maypole Request class (\$r) or uri arg. Need one or other.")
         unless $r;
     my ($obj, $name);
     if (ref $self) { # hidding linking self
          $obj  = $self;
          $name = $args->{name} || $obj->primary_column->name;
     }
         unless $r;
     my ($obj, $name);
     if (ref $self) { # hidding linking self
          $obj  = $self;
          $name = $args->{name} || $obj->primary_column->name;
     }
+    elsif ($obj = $args->{items}->[0]) {
+        $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});
     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;
     }
     $self->_croak("_to_link_hidden has no object") unless ref $obj;
-    my $href =  $url || $r->config->{uri_base} . "/". $obj->table."/view/".$obj->id;
+    my $href =  $uri || $r->config->{uri_base} . "/". $obj->table."/view/".$obj->id;
     my $a = HTML::Element->new('a', 'href' => $href);
     $a->push_content("$obj");
     $a->push_content($self->_to_hidden($name, $obj->id));
     my $a = HTML::Element->new('a', 'href' => $href);
     $a->push_content("$obj");
     $a->push_content($self->_to_hidden($name, $obj->id));
@@ -729,8 +953,6 @@ sub _to_link_hidden {
     $a;
 }
 
     $a;
 }
 
-
-
 =head2 _to_foreign_inputs
 
 $html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]);
 =head2 _to_foreign_inputs
 
 $html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]);
@@ -745,19 +967,22 @@ so it can use edit columns or search_columns
 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.
 
 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 {
 =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') ? 
        
        unless ($fields) {      
                $fields = $classORobj->can('display_columns') ? 
@@ -765,8 +990,8 @@ sub _to_foreign_inputs {
        }
        
        # Ignore our fkey in them to  prevent infinite recursion 
        }
        
        # 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
        my %inputs;
        foreach ( @$fields ) {
                next if $constrained->{$_} || ($_ eq $me); # don't display constrained
@@ -775,7 +1000,7 @@ sub _to_foreign_inputs {
 
        # Make hidden inputs for constrained columns unless we are editing object
        # TODO -- is this right thing to do?
 
        # 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 );  
        }
                $inputs{$_} = $classORobj->_to_hidden($_, $constrained->{$_}) 
                        foreach ( keys %$constrained );  
        }
@@ -804,17 +1029,22 @@ Below handles these formats for the "selected" slot in the arguments hash:
 ############
 sub _hash_selected {
        my ($args) = shift;
 ############
 sub _hash_selected {
        my ($args) = shift;
-       my $selected = $args->{selected};
-    return $selected unless $selected and ref $selected ne 'HASH'; 
+       my $selected = $args->{value} || $args->{selected};
+       #warn "**** SELECTED is $selected ****";
        my $type = ref $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') {
        # 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) {
                return { $selected => 1}; 
        }
     }
     # Single Scalar id 
        elsif (not $type) {
                return { $selected => 1}; 
        }
+       
 
        # Array of objs, arrays, hashes, or just scalalrs. 
        elsif ($type eq 'ARRAY') {
 
        # Array of objs, arrays, hashes, or just scalalrs. 
        elsif ($type eq 'ARRAY') {
@@ -850,9 +1080,12 @@ sub _hash_selected {
 Internal api  method to make the actual select box form elements.
 
 3 types of lists making for -- 
 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 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
 
 
 =cut
 
 
@@ -860,53 +1093,73 @@ Internal api  method to make the actual select box form elements.
 sub _select_guts {
     my ($self, $col, $args) = @_; #$nullable, $selected_id, $values) = @_;
 
 sub _select_guts {
     my ($self, $col, $args) = @_; #$nullable, $selected_id, $values) = @_;
 
-    $args->{stringify} ||=  'stringify_selectbox';
-    $args->{selected} = _hash_selected($args);
+    #$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);
        $a->attr( %{$args->{attr}} ) if $args->{attr};
     
        my $name = $args->{name} || $col;
     my $a = HTML::Element->new('select', name => $name);
        $a->attr( %{$args->{attr}} ) if $args->{attr};
     
-    if ($args->{nullable}) {
-               my $null_element = HTML::Element->new('option');
+    if ($args->{column_nullable}) {
+               my $null_element = HTML::Element->new('option', value => '');
         $null_element->attr(selected => 'selected')
         $null_element->attr(selected => 'selected')
-               if $args->{selected}{'null'};
-               $null_element->push_content('-- choose or type --');
+               if ($args->{selected}{'null'});
         $a->push_content($null_element);
     }
 
         $a->push_content($null_element);
     }
 
-    my $items = $args->{items};
-    my $proto = $items->[0];
-    my $type  = ref $proto || '';
-
-    # Objects 
-    if ($type and  $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]; } || "";
+       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
+    elsif ($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));
     }
     }
-    elsif ($type =~ /HASH/i) { 
-               $a->push_content($self->_options_from_hashes($items, $args));
+    # Array of Arrays
+    elsif ( $type eq 'ARRAY' and $proto eq 'ARRAY' ) {
+        $a->push_content($self->_options_from_arrays($items, $args));
     }
     }
-    else { 
-               $a->push_content($self->_options_from_scalars($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: " .
+       Dumper($items );
     }
 
     return $a;
     }
 
     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.
 
 
 =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) = @_;
 =cut
 sub _options_from_objects {
     my ($self, $items, $args) = @_;
@@ -914,9 +1167,11 @@ sub _options_from_objects {
        my $stringify = $args->{stringify} || '';
     my @res;
        for (@$items) {
        my $stringify = $args->{stringify} || '';
     my @res;
        for (@$items) {
-               my $opt = HTML::Element->new("option", value => $_->id);
-               $opt->attr(selected => "selected") if $selected->{$_->id}; 
-               my $content = $stringify ? $_->$stringify : "$_";
+               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; 
        }
                $opt->push_content($content);
                push @res, $opt; 
        }
@@ -927,39 +1182,61 @@ sub _options_from_arrays {
     my ($self, $items, $args) = @_;
        my $selected = $args->{selected} || {};
     my @res;
     my ($self, $items, $args) = @_;
        my $selected = $args->{selected} || {};
     my @res;
-       my $fclass = $args->{class} || '';
+       my $class = $args->{class} || '';
        my $stringify = $args->{stringify} || '';
        my $stringify = $args->{stringify} || '';
-       for (@$items) {
-               my $id = $_->[0];
-               my $opt = HTML::Element->new("option", value => $id );
-               #$opt->attr(selected => "selected") if $selected =~/^$id$/;
+       for my $item (@$items) {
+           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 $val = defined $id ? $id : '';
+               my $opt = HTML::Element->new("option", value =>$val);
                $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('/', @{$_});
-use Data::Dumper;
-warn "Content is $content";
+               my $content = ($class and $stringify and $class->can($stringify)) ? 
+                             $class->$stringify($_) : 
+                                 join( '/', map { $_ if $_; }@{$item} );
                $opt->push_content( $content );
         push @res, $opt; 
     }
     return @res;
 }
 
                $opt->push_content( $content );
         push @res, $opt; 
     }
     return @res;
 }
 
-sub _options_from_scalars {
+
+sub _options_from_array {
     my ($self, $items, $args) = @_;
     my ($self, $items, $args) = @_;
-       my $selected = $args->{selected} || {};
+    my $selected = $args->{selected} || {};
     my @res;
     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 $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( $_ );
+        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 $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( $_ );
+        push @res, $opt;
     }
     return @res;
 }
 
     }
     return @res;
 }
 
+
 sub _options_from_hashes {
     my ($self, $items, $args) = @_;
        my $selected = $args->{selected} || {};
 sub _options_from_hashes {
     my ($self, $items, $args) = @_;
        my $selected = $args->{selected} || {};
@@ -967,16 +1244,30 @@ sub _options_from_hashes {
        my $fclass = $args->{class} || '';
        my $stringify = $args->{stringify} || '';
        my @res;
        my $fclass = $args->{class} || '';
        my $stringify = $args->{stringify} || '';
        my @res;
-       for my $item (@$items) {
-               my $val = $item->{$pk};
-               my $opt = HTML::Element->new("option", value => $val );
+       for (@$items) {
+               my $val = defined $_->{$pk} ? $_->{$pk} : '';
+               my $opt = HTML::Element->new("option", value => $val);
                $opt->attr(selected => "selected") if $selected->{$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 );
                $opt->push_content( $content );
-        push @res, $opt;
+        push @res, $opt; 
     }
     }
-    return @res;
+       return @res;
 }
 }
+
+# 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
        
 # 
 # checkboxes: if no data in hand (ie called as class method), replace
@@ -990,7 +1281,6 @@ sub _options_from_hashes {
 sub _to_checkbox {
     my ($self, $col, $args) = @_;
     my $nullable = eval {self->column_nullable($col)} || 0; 
 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);
     return $self->_to_radio($col) if !ref($self) || $nullable;
     my $value = $self->$col;
     my $a = HTML::Element->new("input", type=> "checkbox", name => $col);
@@ -1028,37 +1318,49 @@ sub _to_radio {
 
 _rename_foreign_input($html_el_or_hash_of_them); # changes made by reference
 
 
 _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". 
+Recursively renames the foreign inputs made by _to_foreign_inputs so they 
+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 Address named like this: 
+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
 
 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, insert the person and put the person id in the employee->{person} data slot and then insert the employee with that data.
 
 =cut
 
 sub _rename_foreign_input {
 
 =cut
 
 sub _rename_foreign_input {
-       my ($self, $accssr, $input) = @_;
-       if ( ref $input ne 'HASH' ) {
-       #       my $new_name = $accssr . "__AsForeign__" . $input->attr('name');
-               $input->attr( name => $accssr . "__AsForeign__" . $input->attr('name'));
+       my ($self, $accssr, $element) = @_;
+       my $del = $self->foreign_input_delimiter;
+       
+       if ( ref $element ne 'HASH' ) {
+       #       my $new_name = $accssr . "__AF__" . $input->attr('name');
+               $element->attr( name => $accssr . $del . $element->attr('name'));
        }
        else {
        }
        else {
-               $self->_rename_foreign_input($accssr, $input->{$_}) 
-                       foreach (keys %$input);
+               $self->_rename_foreign_input($accssr, $element->{$_}) 
+                       foreach (keys %$element);
        }
 }
        }
 }
+
+=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 
 =head2 _box($value) 
 
 This functions computes the dimensions of a textarea based on the value 
@@ -1066,9 +1368,10 @@ or the defaults.
 
 =cut
 
 
 =cut
 
-our ($min_rows, $max_rows, $min_cols, $max_cols) = (2 => 50, 20 => 100);
 sub _box
 {
 sub _box
 {
+       
+       my ($min_rows, $max_rows, $min_cols, $max_cols) = (2 => 50, 20 => 100);
     my $text = shift;
     if ($text) {
        my @rows = split /^/, $text;
     my $text = shift;
     if ($text) {
        my @rows = split /^/, $text;
@@ -1099,10 +1402,14 @@ sub _box
 
 Maypole Developers
 
 
 Maypole Developers
 
-=head1 ORIGINAL AUTHOR
+=head1 AUTHORS
 
 Peter Speltz, Aaron Trevena 
 
 
 Peter Speltz, Aaron Trevena 
 
+=head1 AUTHORS EMERITUS
+
+Simon Cozens, Tony Bowden
+
 =head1 TODO
 
   Documenting 
 =head1 TODO
 
   Documenting 
@@ -1132,6 +1439,3 @@ L<Class::DBI>, L<Class::DBI::FromCGI>, L<HTML::Element>.
 
 =cut
 
 
 =cut
 
-\r
-\r
-\r
Package: Maypole [unmaintained]