lib/Maypole/Model/CDBI/AsForm.pm

   1 package Maypole::Model::CDBI::AsForm;
   2
   3 #TODO --
   4 # lots of doc
   5 # _to_select_or_create  -- select input stays
   6 # _to_create_or_select  -- create input trumps
   7 #
   8
   9 # TESTED and Works --
  10 #  has_many select -- $obj->to_field($has_many_col);   # select one form many
  11 #                  -- $class->to_field($has_many_col); # foreign inputs
  12 #  $class->search_inputs; /
  13
  14
  15 use strict;
  16 use warnings;
  17
  18 use base 'Exporter';
  19 use Data::Dumper;
  20 use Class::DBI::Plugin::Type ();
  21 use HTML::Element;
  22 use Carp qw/cluck/;
  23
  24 our $OLD_STYLE = 0;
  25 # pjs  --  Added new methods to @EXPORT
  26 our @EXPORT =
  27         qw(
  28                 to_cgi to_field  make_element_foreign search_inputs unselect_element
  29                 _field_from_how _field_from_relationship _field_from_column
  30                 _to_textarea _to_textfield _to_select  _select_guts
  31                 _to_foreign_inputs _to_enum_select _to_bool_select
  32                 _to_hidden _to_link_hidden _rename_foreign_input _to_readonly
  33                 _options_from_objects _options_from_arrays _options_from_hashes
  34                 _options_from_array _options_from_hash
  35     );
  36
  37 our $VERSION = '.10';
  38
  39 =head1 NAME
  40
  41 Maypole::Model:CDBI::AsForm - Produce HTML form elements for database columns
  42
  43 =head1 SYNOPSIS
  44
  45     package Music::CD;
  46     use Maypole::Model::CDBI::AsForm;
  47     use base 'Class::DBI';
  48     use CGI;
  49     ...
  50
  51     sub create_or_edit {
  52         my $self = shift;
  53         my %cgi_field = $self->to_cgi;
  54         return start_form,
  55                (map { "<b>$_</b>: ". $cgi_field{$_}->as_HTML." <br>" }
  56                     $class->Columns),
  57                end_form;
  58     }
  59
  60 # Example of has_many select
  61 package Job;
  62 __PACKAGE__->has_a('job_employer' => 'Employer');
  63 __PACKAGE__->has_a('contact'  => 'Contact')
  64
  65 package Contact;
  66 __PACKAGE__->has_a('cont_employer' => 'Employer');
  67 __PACKAGE__->has_many('jobs'  => 'Job',
  68         { join => { job_employer => 'cont_employer' },
  69           constraint => { 'finshed' => 0  },
  70           order_by   => "created ASC",
  71         }
  72 );
  73
  74 package Employer;
  75 __PACKAGE__->has_many('jobs'  => 'Job',);
  76 __PACKAGE__->has_many('contacts'  => 'Contact',
  77             order_by => 'name DESC',
  78 );
  79
  80
  81   # Choose some jobs to add to a contact (has multiple attribute).
  82   my $job_sel = Contact->to_field('jobs'); # Uses constraint and order by
  83
  84
  85   # Choose a job from $contact->jobs
  86   my $job_sel = $contact->to_field('jobs');
  87
  88
  89
  90 =head1 DESCRIPTION
  91
  92 This module helps to generate HTML forms for creating new database rows
  93 or editing existing rows. It maps column names in a database table to
  94 HTML form elements which fit the schema. Large text fields are turned
  95 into textareas, and fields with a has-a relationship to other
  96 C<Class::DBI> tables are turned into select drop-downs populated with
  97 objects from the joined class.
  98
  99
 100 =head1 ARGUMENTS HASH
 101
 102 This provides a convenient way to tweak AsForm's behavior in exceptional or
 103 not so exceptional instances. Below describes the arguments hash and
 104 example usages.
 105
 106
 107   $beer->to_field($col, $how, $args);
 108   $beer->to_field($col, $args);
 109
 110 Not all _to_* methods pay attention to all arguments. For example, '_to_textfield' does not look in $args->{'items'} at all.
 111
 112 =over
 113
 114 =item name -- the name the element will have , this trumps the derived name.
 115
 116   $beer->to_field('brewery', 'readonly', {
 117                 name => 'brewery_id'
 118   });
 119
 120 =item value -- the initial value the element will have, trumps derived value
 121
 122   $beer->to_field('brewery', 'textfield', {
 123                 name => 'brewery_id', value => $beer->brewery,
 124                 # however, no need to set value since $beer is object
 125   });
 126
 127 =item items -- array of items generally used to make select box options
 128
 129 Can be array of objects, hashes, arrays, or strings, or just a hash.
 130
 131    # Rate a beer
 132    $beer->to_field(rating =>  select => {
 133                 items => [1 , 2, 3, 4, 5],
 134    });
 135
 136    # Select a Brewery to visit in the UK
 137    Brewery->to_field(brewery_id => {
 138                 items => [ Brewery->search_like(location => 'UK') ],
 139    });
 140
 141   # Make a select for a boolean field
 142   $Pub->to_field('open' , { items => [ {'Open' => 1, 'Closed' => 0 } ] });
 143
 144 =item selected -- something representing which item is selected in a select box
 145
 146    $beer->to_field('brewery', {
 147                 selected => $beer->brewery, # again not necessary since caller is obj.
 148    });
 149
 150 Can be an simple scalar id, an object, or an array of either
 151
 152 =item class -- the class for which the input being made for field pertains to.
 153
 154 This in almost always derived in cases where it may be difficult to derive, --
 155    # Select beers to serve on handpump
 156    Pub->to_field(handpumps => select => {
 157                 class => 'Beer', order_by => 'name ASC', multiple => 1,
 158         });
 159
 160 =item column_type -- a string representing column type
 161
 162   $pub->to_field('open', 'bool_select', {
 163                 column_type => "bool('Closed', 'Open'),
 164   });
 165
 166 =item column_nullable -- flag saying if column is nullable or not
 167
 168 Generally this can be set to get or not get a null/empty option added to
 169 a select box.  AsForm attempts to call "$class->column_nullable" to set this
 170 and it defaults to true if there is no shuch method.
 171
 172   $beer->to_field('brewery', { column_nullable => 1 });
 173
 174 =item r or request  -- the mapyole request object
 175
 176 =item uri -- uri for a link , used in methods such as _to_link_hidden
 177
 178  $beer->to_field('brewery', 'link_hidden',
 179       {r => $r, uri => 'www.maypole.perl.org/brewery/view/'.$beer->brewery});
 180  # an html link that is also a hidden input to the object. R is required to
 181  # make the uri  unless you  pass a  uri
 182
 183 =item order_by, constraint, join
 184
 185 These are used in making select boxes. order_by is a simple order by clause
 186 and constraint and join are hashes used to limit the rows selected. The
 187 difference is that join uses methods of the object and constraint uses
 188 static values. You can also specify these in the relationship arguments.
 189
 190   BeerDB::LondonBeer->has_a('brewery', 'BeerDB::Brewery',
 191            order_by     => 'brewery_name ASC',
 192            constraint   => {location  => 'London'},
 193            'join'       => {'brewery_tablecolumn  => 'beer_obj_column'},
 194           );
 195
 196 =item no_hidden_constraints --
 197
 198 Tell AsForm not to make hidden inputs for relationship constraints. It does
 199 this  sometimes when making foreign inputs .
 200
 201 =back
 202
 203 =head2 to_cgi
 204
 205   $self->to_cgi([@columns, $args]);
 206
 207 This returns a hash mapping all the column names to HTML::Element objects
 208 representing form widgets.  It takes two opitonal arguments -- a list of
 209 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.
 210
 211   $self->to_cgi(); # uses $self->columns;  # most used
 212   $self->to_cgi(qw/brewery style rating/); # sometimes
 213   # and on rare occassions this is desireable if you have a lot of fields
 214   # and dont want to call to_field a bunch of times just to tweak one or
 215   # two of them.
 216   $self->to_cgi(@cols, {brewery => {
 217                                      how => 'textfield' # too big for select
 218                                                                    },
 219                         style   => {
 220                                                              column_nullable => 0,
 221                                                              how => 'select',
 222                                                                      items => ['Ale', 'Lager']
 223                                                                    }
 224                                                 }
 225
 226 =cut
 227
 228 sub to_cgi {
 229         my ($class, @columns) = @_; # pjs -- added columns arg
 230         my $args = {};
 231         if (not @columns) {
 232                 @columns = $class->columns;
 233         }
 234         else {
 235                 if ( ref $columns[-1] eq 'HASH' ) { $args = pop @columns; }
 236         }
 237         map { $_ => $class->to_field($_, $args->{$_}) } @columns;
 238 }
 239
 240 =head2 to_field($field [, $how][, $args])
 241
 242 This maps an individual column to a form element. The C<how> argument
 243 can be used to force the field type into any you want. It tells AsForm how
 244 to make the input ie-- forces it to use the method "_to_$how".
 245 If C<how> is specified but the class cannot call the method it maps to,
 246 then AsForm will issue a warning and the default input will be made.
 247 You can write your own "_to_$how" methods and AsForm comes with many.
 248 See C<HOW Methods>. You can also pass this argument in $args->{how}.
 249
 250
 251 =cut
 252
 253 sub to_field {
 254         my ($self, $field, $how, $args) = @_;
 255     if (ref $how)   { $args = $how; $how = ''; }
 256         unless ($how)   { $how = $args->{how} || ''; }
 257 #warn "In to_field field is $field how is $how. args ar e" . Dumper($args) . " \n";
 258
 259     #if (ref $field) { $args = $field; $field = '' }
 260
 261         #use Data::Dumper;
 262         #warn "args to_field  are $field, . " . Dumper($how) . " ,  " . Dumper($args);
 263
 264
 265         return  $self->_field_from_how($field, $how, $args)   ||
 266                 $self->_field_from_relationship($field, $args) ||
 267                         $self->_field_from_column($field, $args)  ||
 268                         $self->_to_textfield($field, $args);
 269 }
 270
 271 =head2 search_inputs
 272
 273   my $cgi = $class->search_inputs ([$args]); # optional $args
 274
 275 Returns hash or hashref of search inputs elements for a class making sure the
 276 inputs are empty of any initial values.
 277 You can specify what columns you want inputs for in
 278 $args->{columns} or
 279 by the method "search_columns". The default is  "display_columns".
 280 If you want to te search on columns in related classes you can do that by
 281 specifying a one element hashref in place of the column name where
 282 the key is the related "column" (has_a or has_many method for example) and
 283 the value is a list ref of columns to search on in the related class.
 284
 285 Example:
 286   sub  BeerDB::Beer::search_columns {
 287      return ( 'name' , 'rating', { brewery => [ 'name', 'location'] } );
 288   }
 289
 290   # Now foreign inputs are made for Brewery name and location and the
 291   # there will be no name clashing and processing can be automated.
 292
 293 =cut
 294
 295
 296 sub search_inputs {
 297     my ($class, $args) = @_;
 298     $class = ref $class || $class;
 299     #my $accssr_class = { $class->accessor_classes };
 300     my %cgi;
 301
 302     $args->{columns} ||= $class->can('search_columns') ?[$class->search_columns] : [$class->display_columns];
 303
 304     foreach my $field ( @{ $args->{columns} } ) {
 305                 my $base_args = {
 306                         no_hidden_constraints => 1,
 307                         column_nullable => 1, # empty option on select boxes
 308                         value  => '',
 309                 };
 310         if ( ref $field eq "HASH" ) { # foreign search fields
 311             my ($accssr, $cols)  = each %$field;
 312                         $base_args->{columns} = $cols;
 313             unless (  @$cols ) {
 314                 # default to search fields for related
 315                 #$cols =  $accssr_class->{$accssr}->search_columns;
 316                 die ("$class search_fields error: Must specify at least one column to search in the foreign object named '$accssr'");
 317             }
 318             my $fcgi  = $class->to_field($accssr, 'foreign_inputs', $base_args);
 319
 320             # unset the default values for a select box
 321             foreach (keys %$fcgi) {
 322                         my $el = $fcgi->{$_};
 323                                 if ($el->tag eq 'select') {
 324
 325                                         $class->unselect_element($el);
 326                                         my ($first, @content) = $el->content_list;
 327                                         my @fc = $first->content_list;
 328                                         my $val = $first ? $first->attr('value') : undef;
 329                                         if ($first and (@fc > 0 or (defined $val and $val ne '')) ) { # something ( $first->attr('value') ne '' or
 330
 331                                            #(defined $first->attr('value') or $first->attr('value') ne ''))
 332                                            # push an empty option on stactk
 333                                            $el->unshift_content(HTML::Element->new('option'));
 334                                     }
 335                                 }
 336
 337             }
 338             $cgi{$accssr} = $fcgi;
 339                         delete $base_args->{columns};
 340                 }
 341         else {
 342             $cgi{$field} = $class->to_field($field, $base_args); #{no_select => $args->{no_select}{$field} });
 343                 my $el = $cgi{$field};
 344                         if ($el->tag eq 'select') {
 345                                 $class->unselect_element($el);
 346                                 my ($first, @content) = $el->content_list;
 347                                 if ($first and $first->content_list) { # something
 348                                            #(defined $first->attr('value') or $first->attr('value') ne ''))
 349                                            # push an empty option on stactk
 350                                            $el->unshift_content(HTML::Element->new('option'));
 351                                 }
 352                         }
 353         }
 354     }
 355     return \%cgi;
 356 }
 357
 358
 359
 360
 361 =head2 unselect_element
 362
 363   unselect any selected elements in a HTML::Element select list widget
 364
 365 =cut
 366 sub unselect_element {
 367    my ($self, $el) = @_;
 368    #unless (ref $el eq 'HTML::Element') {
 369    #$self->_croak ('Need an HTML::Element to unselect. You gave a ' . Dumper($el)); }
 370    if ($el->tag eq 'select') {
 371        foreach my $opt ($el->content_list) {
 372            $opt->attr('selected', undef) if $opt->attr('selected');
 373        }
 374    }
 375 }
 376
 377 =head2 _field_from_how($field, $how,$args)
 378
 379 Returns an input element based the "how" parameter or nothing at all.
 380 Override at will.
 381
 382 =cut
 383
 384 sub _field_from_how {
 385         my ($self, $field, $how, $args) = @_;
 386         return unless $how;
 387         $args ||= {};
 388         no strict 'refs';
 389         my $meth = "_to_$how";
 390         if (not $self->can($meth)) {
 391                 warn "Class can not $meth";
 392                 return;
 393         }
 394         return $self->$meth($field, $args);
 395         return;
 396 }
 397
 398 =head2 _field_from_relationship($field, $args)
 399
 400 Returns an input based on the relationship associated with the field or nothing.
 401 Override at will.
 402
 403 For has_a it will give select box
 404
 405 =cut
 406
 407 sub _field_from_relationship {
 408         my ($self, $field, $args) = @_;
 409         return unless $field;
 410         my $rel_meta = $self->related_meta('r',$field) || return;
 411         my $rel_name = $rel_meta->{name};
 412         #my $meta = $self->meta_info;
 413         #grep{ defined $meta->{$_}{$field} } keys %$meta;
 414         my $fclass = $rel_meta->foreign_class;
 415         my $fclass_is_cdbi = $fclass ? $fclass->isa('Class::DBI') : 0;
 416
 417         # maybe has_a select
 418         if ($rel_meta->{name} eq 'has_a' and $fclass_is_cdbi) {
 419             # This condictions allows for trumping of the has_a args
 420                 if  (not $rel_meta->{args}{no_select} and not $args->{no_select})
 421                 {
 422                 $args->{class} = $fclass;
 423                 return  $self->_to_select($field, $args);
 424                 }
 425                 return;
 426         }
 427         # maybe has many select
 428         if ($rel_meta->{name} eq 'has_many' and $fclass_is_cdbi and ref $self) {
 429             # This condictions allows for trumping of the has_a args
 430                 if  (not $rel_meta->{args}{no_select} and not $args->{no_select})
 431                 {
 432                 $args->{class} = $fclass;
 433                         $args->{items} = $self->$field;
 434                 return  $self->_to_select($field, $args);
 435                 }
 436                 return;
 437         }
 438
 439
 440
 441         #NOOO!  maybe select from has_many
 442 #       if ($rel_type eq 'has_many' and ref $self) {
 443 #               $args->{items} ||= [$self->$field];
 444 #               # arg name || fclass pk name || field
 445 #               if (not $args->{name}) {
 446 #                       $args->{name} =  eval{$fclass->primary_column->name} || $field;
 447 #               }
 448 #       return  $self->_to_select($field, $args);
 449 #       }
 450 #
 451         # maybe foreign inputs
 452         my %local_cols = map { $_ => 1 } $self->columns; # includes is_a cols
 453         if ($fclass_is_cdbi and (not $local_cols{$field} or $rel_name eq 'has_own'))
 454         {
 455                 $args->{related_meta} = $rel_meta; # suspect faster to set these args
 456                 return $self->_to_foreign_inputs($field, $args);
 457         }
 458         return;
 459 }
 460
 461 =head2 _field_from_column($field, $args)
 462
 463 Returns an input based on the column's characteristics, namely type, or nothing.
 464 Override at will.
 465
 466 =cut
 467
 468 sub _field_from_column {
 469         my ($self, $field, $args) = @_;
 470         return unless $field;
 471         my $class = ref $self || $self;
 472         # Get column type
 473     unless ($args->{column_type}) {
 474         if ($class->can('column_type')) {
 475                         $args->{column_type} = $class->column_type($field);
 476                 }
 477                 else {
 478                 # Right, have some of this
 479                 eval "package $class; Class::DBI::Plugin::Type->import()";
 480                 $args->{column_type} = $class->column_type($field);
 481                 }
 482     }
 483     my $type = $args->{column_type};
 484
 485         return $self->_to_textfield($field, $args)
 486                 if $type  and $type =~ /^(VAR)?CHAR/i;  #common type
 487         return $self->_to_textarea($field, $args)
 488                 if $type and $type =~ /^(TEXT|BLOB)$/i;
 489         return $self->_to_enum_select($field, $args)
 490                 if $type and  $type =~ /^ENUM\((.*?)\)$/i;
 491         return $self->_to_bool_select($field, $args)
 492                 if $type and  $type =~ /^BOOL/i;
 493         return $self->_to_readonly($field, $args)
 494             if $type and $type =~ /^readonly$/i;
 495         return;
 496 }
 497
 498
 499 sub _to_textarea {
 500         my ($self, $col, $args) = @_;
 501         # pjs added default
 502     $args ||= {};
 503     my $val =  $args->{value};
 504
 505     unless (defined $val) {
 506         if (ref $self) {
 507                         $val = $self->$col;
 508                 }
 509                 else {
 510                         $val = eval {$self->column_default($col);};
 511                 $val = '' unless defined $val;
 512                 }
 513         }
 514     my ($rows, $cols) = _box($val);
 515     $rows = $args->{rows} if $args->{rows};
 516     $cols = $args->{cols} if $args->{cols};;
 517     my $name = $args->{name} || $col;
 518         my $a =
 519                 HTML::Element->new("textarea", name => $name, rows => $rows, cols => $cols);
 520         $a->push_content($val);
 521         $OLD_STYLE && return $a->as_HTML;
 522         $a;
 523 }
 524
 525 sub _to_textfield {
 526     my ($self, $col, $args ) = @_;
 527     use Carp qw/confess/;
 528     confess "No col passed to _to_textfield" unless $col;
 529     $args ||= {};
 530     my $val  = $args->{value};
 531     my $name = $args->{name} || $col;
 532
 533     unless (defined $val) {
 534         if (ref $self) {
 535             # Case where column inflates.
 536             # Input would get stringification which could be not good.
 537             #  as in the case of Time::Piece objects
 538             $val = $self->can($col) ? $self->$col : ''; # in case it is a virtual column
 539             if (ref $val) {
 540                                 if (my $meta = $self->related_meta('',$col)) {
 541                         if (my $code = $meta->{args}{deflate4edit} || $meta->{args}{deflate} ) {
 542                         $val  = ref $code ? &$code($val) : $val->$code;
 543                                         }
 544                                         elsif ( $val->isa('Class::DBI') ) {
 545                                             $val  = $val->id;
 546                                         }
 547                                         else {
 548                                                 #warn "No deflate4edit code defined for $val of type " .
 549                                              #ref $val . ". Using the stringified value in textfield..";
 550                                         }
 551                 }
 552                                 else {
 553                                         $val  = $val->id if $val->isa("Class::DBI");
 554                }
 555                 }
 556
 557         }
 558         else {
 559                 $val = eval {$self->column_default($col);};
 560                 $val = '' unless defined $val;
 561         }
 562     }
 563         my $a;
 564         # THIS If section is neccessary or you end up with "value" for a vaiue
 565         # if val is
 566         $val = '' unless defined $val;
 567         $a = HTML::Element->new("input", type => "text", name => $name, value =>$val);
 568     $OLD_STYLE && return $a->as_HTML;
 569     $a;
 570 }
 571
 572
 573 # Too expensive version -- TODO
 574 #sub _to_select {
 575 #       my ($self, $col, $hint) = @_;
 576 #       my $fclass = $hint || $self->__hasa_rels->{$col}->[0];
 577 #       my @objs        = $fclass->retrieve_all;
 578 #       my $a           = HTML::Element->new("select", name => $col);
 579 #       for (@objs) {
 580 #               my $sel = HTML::Element->new("option", value => $_->id);
 581 #               $sel->attr("selected" => "selected")
 582 #                       if ref $self
 583 #                       and eval { $_->id eq $self->$col->id };
 584 #               $sel->push_content($_->stringify_self);
 585 #               $a->push_content($sel);
 586 #       }
 587 #       $OLD_STYLE && return $a->as_HTML;
 588 #       $a;
 589 #}
 590
 591
 592
 593 # pjs
 594 # -- Rewrote this to be efficient -- no object creation.
 595 # -- Added option for CDBI classes to specify a limiting clause
 596 # via "has_a_select_limit".
 597 # -- Added selected argument to set a selected
 598
 599 =head2 recognized arguments
 600
 601   selected => $object|$id,
 602   name     => $name,
 603   value    => $value,
 604   where    => SQL 'WHERE' clause,
 605   order_by => SQL 'ORDER BY' clause,
 606   limit    => SQL 'LIMIT' clause,
 607   items    => [ @items_of_same_type_to_select_from ],
 608   class => $class_we_are_selecting_from
 609   stringify => $stringify_coderef|$method_name
 610
 611
 612
 613
 614 # select box requirements
 615 # 1. a select box for objecs of a has_a related class -- DONE
 616 =head2  1. a select box out of a has_a or has_many related class.
 617   # For has_a the default behavior is to make a select box of every element in
 618   # related class and you choose one.
 619   #Or explicitly you can create one and pass options like where and order
 620   BeerDB::Beer->to_field('brewery','select', {where => "location = 'Germany'");
 621
 622   # For has_many the default is to get a multiple select box with all objects.
 623   # If called as an object method, the objects existing ones will be selected.
 624   Brewery::BeerDB->to_field('beers','select', {where => "rating > 5"});
 625
 626
 627 =head2  2. a select box for objects of arbitrary class -- say BeerDB::Beer for fun.
 628   # general
 629   BeerDB::Beer->to_field('', 'select', $options)
 630
 631   BeerDB::Beer->to_field('', 'select'); # Select box of all the rows in class
 632                                   # with PK as ID, $Class->to_field() same.
 633   BeerDB::Beer->to_field('','select',{ where => "rating > 3 AND class like 'Ale'", order_by => 'rating DESC, beer_id ASC' , limit => 10});
 634   # specify exact where clause
 635
 636 =head2 3. If you already have a list of objects to select from  --
 637
 638   BeerDB:;Beer->to_field($col, 'select' , {items => $objects});
 639
 640 # 3. a select box for arbitrary set of objects
 641  # Pass array ref of objects as first arg rather than field
 642  $any_class_or_obj->to_field([BeerDB::Beer->search(favorite => 1)], 'select',);
 643
 644
 645 =cut
 646
 647 sub _to_select {
 648     my ($self, $col, $args) = @_;
 649     $args ||= {};
 650 # Do we have items already ? Go no further.
 651     if ($args->{items} and ref $args->{items}) {
 652         my $a = $self->_select_guts($col,  $args);
 653         $OLD_STYLE && return $a->as_HTML;
 654                 if ($args->{multiple}) { $a->attr('multiple', 'multiple');}
 655                 return $a;
 656         }
 657
 658 # Else what are we making a select box out of ?
 659         # No Column parameter --  means making a select box of args->class or self
 660     # Using all rows from class's table
 661     if (not $col) {
 662                 unless ($args->{class}) {
 663                 $args->{class} = ref $self || $self;
 664                         # object selected if called with one
 665             $args->{selected} = { $self->id => 1}
 666                                 if not $args->{selected} and ref $self;
 667                 }
 668         $col = $args->{class}->primary_column;
 669     }
 670     # Related Class maybe ?
 671     elsif (my $rel_meta =  $self->related_meta('r:)', $col) ) {
 672         $args->{class} = $rel_meta->{foreign_class};
 673         # related objects pre selected if object
 674
 675                 # "Has many" -- Issues:
 676                 # 1) want to select one from list if self is an object
 677                 # Thats about all we can do really,
 678                 # 2) except for mapping which is TODO and  would
 679                 # do something like add to and take away from list of permissions for
 680                 # example.
 681
 682                 # Hasmany select one from list if ref self
 683                 if ($rel_meta->{name} =~ /has_many/i and ref $self) {
 684                         $args->{items} = [ $self->$col ];
 685                         my $a = $self->_select_guts($col,  $args);
 686                     $OLD_STYLE && return $a->as_HTML;
 687                     return $a;
 688                 }
 689                 else {
 690                         $args->{selected} ||= [ $self->$col ] if  ref $self;
 691                         #warn "selected is " . Dumper($args->{selected});
 692                         my $c = $rel_meta->{args}{constraint} || {};
 693                         my $j = $rel_meta->{args}{join} || {};
 694                         my @join ;
 695                         if (ref $self) {
 696                                 @join   =  map { $_ ." = ". $self->_attr($_) } keys %$j;
 697                         }
 698                         my @constr= map { "$_ = '$c->{$_}'"} keys %$c;
 699                         $args->{where}    ||= join (' AND ', (@join, @constr));
 700                         $args->{order_by} ||= $rel_meta->{args}{order_by};
 701                         $args->{limit}    ||= $rel_meta->{args}{limit};
 702                 }
 703
 704     }
 705     # We could say :Col is name and we are selecting  out of class arg.
 706         # DIE for now
 707         else {
 708                 #$args->{name} = $col;
 709                 die "Usage _to_select. $col not related to any class to select from. ";
 710
 711     }
 712
 713     # Set arguments
 714         unless ( defined  $args->{column_nullable} ) {
 715             $args->{column_nullable} = $self->can('column_nullable') ?
 716                          $self->column_nullable($col) : 1;
 717         }
 718
 719         # Get items to select from
 720     $args->{items} = _select_items($args);
 721         #use Data::Dumper;
 722         #warn "Just got items. They are  " . Dumper($args->{items});
 723
 724         # Make select HTML element
 725         $a = $self->_select_guts($col, $args);
 726
 727         if ($args->{multiple}) {$a->attr('multiple', 'multiple');}
 728
 729         # Return
 730     $OLD_STYLE && return $a->as_HTML;
 731     $a;
 732
 733 }
 734
 735
 736 ##############
 737 # Function #
 738 # #############
 739 # returns the intersection of list refs a and b
 740 sub _list_intersect {
 741         my ($a, $b) = @_;
 742         my %isect; my %union;
 743     foreach my $e (@$a, @$b) { $union{$e}++ && $isect{$e}++ }
 744         return  %isect;
 745 }
 746 ############
 747 # FUNCTION #
 748 ############
 749 # Get Items
 750 sub _select_items {
 751         my $args = shift;
 752         my $fclass = $args->{class};
 753     my @disp_cols = @{$args->{columns} || []};
 754     @disp_cols = $fclass->columns('SelectBox') unless @disp_cols;
 755     @disp_cols = $fclass->columns('Stringify')unless @disp_cols;
 756     @disp_cols = $fclass->_essential unless @disp_cols;
 757         unshift @disp_cols,  $fclass->columns('Primary');
 758         #my %isect = _list_intersect(\@pks, \@disp_cols);
 759         #foreach (@pks) { push @sel_cols, $_ unless $isect{$_}; }
 760     #push @sel_cols, @disp_cols;
 761
 762         #warn "in select items. args are : " . Dumper($args);
 763         my $distinct = '';
 764         if ($args->{'distinct'}) {
 765         $distinct = 'DISTINCT ';
 766         }
 767
 768     my $sql = "SELECT $distinct" . join( ', ', @disp_cols) .
 769                   " FROM " . $fclass->table;
 770
 771         $sql .= " WHERE " . $args->{where}   if $args->{where};
 772         $sql .= " ORDER BY " . $args->{order_by} if $args->{order_by};
 773         $sql .= " LIMIT " . $args->{limit} if $args->{limit};
 774         #warn "_select_items sql is : $sql";
 775
 776         return $fclass->db_Main->selectall_arrayref($sql);
 777
 778 }
 779
 780
 781 # Makes a readonly input box out of column's value
 782 # No args makes object to readonly
 783 sub _to_readonly {
 784     my ($self, $col, $args) = @_;
 785     my $val = $args->{value};
 786     if (not defined $val ) { # object to readonly
 787         $self->_croak("AsForm: To readonly field called as class method without a value") unless ref $self;
 788         $val = $self->id;
 789         $col = $self->primary_column;
 790     }
 791     my $a = HTML::Element->new('input', 'type' => 'text', readonly => '1',
 792         'name' => $col, 'value'=>$val);
 793         $OLD_STYLE && return $a->as_HTML;
 794     $a;
 795 }
 796
 797
 798 =head2 _to_enum_select
 799
 800 $sel_box = $self->_to_enum_select($column, "ENUM('Val1','Val2','Val3')");
 801
 802 Returns an enum select box given a column name and an enum string.
 803 NOTE: The Plugin::Type does not return an enum string for mysql enum columns.
 804 This will not work unless you write your own column_type method in your model.
 805
 806 =cut
 807
 808 sub _to_enum_select {
 809     my ($self, $col, $args) = @_;
 810         my $type = $args->{column_type};
 811     $type =~ /ENUM\((.*?)\)/i;
 812     (my $enum = $1) =~ s/'//g;
 813     my @enum_vals = split /\s*,\s*/, $enum;
 814
 815     # determine which is pre selected --
 816     # if obj, the value is , otherwise use column_default which is the first
 817     # value in the enum list unless it has been overridden
 818     my $selected = eval { $self->$col  };
 819     $selected = eval{$self->column_default($col)} unless defined $selected;
 820     $selected = $enum_vals[0]               unless defined $selected;
 821
 822     my $a = HTML::Element->new("select", name => $col);
 823     for ( @enum_vals ) {
 824         my $sel = HTML::Element->new("option", value => $_);
 825         $sel->attr("selected" => "selected") if $_ eq $selected ;
 826         $sel->push_content($_);
 827         $a->push_content($sel);
 828     }
 829     $OLD_STYLE && return $a->as_HTML;
 830     $a;
 831 }
 832
 833
 834 =head2 _to_bool_select
 835
 836   my $sel = $self->_to_bool_select($column, $bool_string);
 837
 838 This  makes select input for boolean column.  You can provide a
 839 bool string of form: Bool('zero','one') and those are used for option
 840 content. Onthervise No and Yes are used.
 841 TODO -- test without bool string.
 842
 843 =cut
 844
 845 # TCODO fix this mess with args
 846 sub _to_bool_select {
 847     my ($self, $col, $args) = @_;
 848         my $type = $args->{column_type};
 849         my @bool_text = ('No', 'Yes');
 850         if ($type =~ /BOOL\((.+?)\)/i) {
 851                 (my $bool = $1) =~ s/'//g;
 852                 @bool_text = split /,/, $bool;
 853         }
 854
 855         # get selectedod
 856
 857         my $selected = $args->{value} if defined $args->{value};
 858         $selected = $args->{selected} unless defined $selected;
 859         $selected =  ref $self ? eval {$self->$col;} : $self->column_default($col)
 860                 unless (defined $selected);
 861
 862     my $a = HTML::Element->new("select", name => $col);
 863     if ($args->{column_nullable} || $args->{value} eq '') {
 864                 my $null =  HTML::Element->new("option");
 865                 $null->attr('selected', 'selected') if  $args->{value} eq '';
 866             $a->push_content( $null );
 867         }
 868
 869     my ($opt0, $opt1) = ( HTML::Element->new("option", value => 0),
 870                                                   HTML::Element->new("option", value => 1) );
 871     $opt0->push_content($bool_text[0]);
 872     $opt1->push_content($bool_text[1]);
 873         unless ($selected eq '') {
 874         $opt0->attr("selected" => "selected") if not $selected;
 875         $opt1->attr("selected" => "selected") if $selected;
 876         }
 877     $a->push_content($opt0, $opt1);
 878     $OLD_STYLE && return $a->as_HTML;
 879     $a;
 880 }
 881
 882
 883 =head2 _to_hidden($col, $args)
 884
 885 This makes a hidden html element. Give it a name and value or if name is
 886 a ref it will use the PK name and value of the object.
 887
 888 =cut
 889
 890 sub _to_hidden {
 891     my ($self, $name, $val) = @_;
 892     my $args = {};
 893     my $obj;
 894     if (ref $name and $name->isa("Class::DBI")) {
 895        $obj = $name;
 896        $name= ($obj->primary_columns)[0]->name;
 897     }
 898     if (ref $val) {
 899                 $args = $val;
 900         $val = $args->{value};
 901         $name = $args->{name} if $args->{name};
 902     }
 903     elsif (not $name ) { # hidding object caller
 904         $self->_croak("No object available in _to_hidden") unless ref $self;
 905         $name = ($self->primary_column)[0]->name;
 906         $val  = $self->id;
 907     }
 908     return HTML::Element->new('input', 'type' => 'hidden',
 909                               'name' => $name, 'value'=>$val
 910     );
 911 }
 912
 913 =head2 _to_link_hidden($col, $args)
 914
 915 Makes a link with a hidden input with the id of $obj as the value and name.
 916 Name defaults to the objects primary key. The object defaults to self.
 917
 918 =cut
 919
 920 sub _to_link_hidden {
 921     my ($self, $accessor, $args) = @_;
 922     my $r =  eval {$self->controller} || $args->{r} || '';
 923     my $uri = $args->{uri} || '';
 924    use Data::Dumper;
 925     $self->_croak("_to_link_hidden cant get uri. No  Maypole Request class (\$r) or uri arg. Need one or other.")
 926         unless $r;
 927     my ($obj, $name);
 928     if (ref $self) { # hidding linking self
 929          $obj  = $self;
 930          $name = $args->{name} || $obj->primary_column->name;
 931     }
 932     elsif ($obj = $args->{items}->[0]) {
 933         $name = $args->{name} || $accessor || $obj->primary_column->name;
 934                 # TODO use meta data above maybe
 935     }
 936     else {           # hiding linking related object with id in args
 937         $obj  = $self->related_class($r, $accessor)->retrieve($args->{id});
 938         $name = $args->{name} || $accessor ; #$obj->primary_column->name;
 939                 # TODO use meta data above maybe
 940     }
 941     $self->_croak("_to_link_hidden has no object") unless ref $obj;
 942     my $href =  $uri || $r->config->{uri_base} . "/". $obj->table."/view/".$obj->id;
 943     my $a = HTML::Element->new('a', 'href' => $href);
 944     $a->push_content("$obj");
 945     $a->push_content($self->_to_hidden($name, $obj->id));
 946         $OLD_STYLE && return $a->as_HTML;
 947     $a;
 948 }
 949
 950 =head2 _to_foreign_inputs
 951
 952 $html_els = $class_or_obj->_to_foreign_inputs($accssr, [$fields, $accssr_meta]);
 953
 954 Get inputs for the accessor's class.  Pass an array ref of fields to get
 955 inputs for only those fields. Otherwise display_columns or all columns is used.
 956 If you have the meta info handy for the accessor you can pass that too.
 957
 958 TODO make AsForm know more about the request like what action we are doing
 959 so it can use edit columns or search_columns
 960
 961 NOTE , this names the foreign inputs is a particular way so they can be
 962 processed with a general routine and so there are not name clashes.
 963
 964 args -
 965 related_meta -- if you have this, great, othervise it will determine or die
 966 columns  -- list of columns to make inputs for
 967
 968 =cut
 969
 970 sub _to_foreign_inputs {
 971         my ($self, $accssr, $args) = @_;
 972         my $rel_meta = $args->{related_meta} || $self->related_meta('r',$accssr);
 973         my $fields              = $args->{columns};
 974         if (!$rel_meta) {
 975                 $self->_croak( "No relationship for accessor $accssr");
 976         }
 977
 978         my $rel_type = $rel_meta->{name};
 979         my $classORobj = ref $self && ref $self->$accssr ? $self->$accssr : $rel_meta->{foreign_class};
 980
 981         unless ($fields) {
 982                 $fields = $classORobj->can('display_columns') ?
 983                         [$classORobj->display_columns] : [$classORobj->columns];
 984         }
 985
 986         # Ignore our fkey in them to  prevent infinite recursion
 987         my $me          = eval {$rel_meta->{args}{foreign_column}} || '';
 988         my $constrained = $rel_meta->{args}{constraint};
 989         my %inputs;
 990         foreach ( @$fields ) {
 991                 next if $constrained->{$_} || ($_ eq $me); # don't display constrained
 992                 $inputs{$_} =  $classORobj->to_field($_);
 993         }
 994
 995         # Make hidden inputs for constrained columns unless we are editing object
 996         # TODO -- is this right thing to do?
 997         unless (ref $classORobj || $args->{no_hidden_constraints}) {
 998                 $inputs{$_} = $classORobj->_to_hidden($_, $constrained->{$_})
 999                         foreach ( keys %$constrained );
1000         }
1001         $self->_rename_foreign_input($accssr, \%inputs);
1002         return \%inputs;
1003 }
1004
1005
1006 =head2 _hash_selected
1007
1008 Method to make sense out of the "selected" argument which can be in a number
1009 of formats perhaps.  It returns a hashref with the the values of options to be
1010 as the keys.
1011
1012 Below handles these formats for the "selected" slot in the arguments hash:
1013   Object (with id method)
1014   Scalar (assumes it is value)
1015   Array ref *OF* objects, arrays of data (0 elmnt used), hashes of data
1016     (id key used), and simple scalars.
1017
1018
1019 =cut
1020
1021 ############
1022 # FUNCTION #
1023 ############
1024 sub _hash_selected {
1025         my ($args) = shift;
1026         my $selected = $args->{value} || $args->{selected};
1027     return $selected unless $selected and ref $selected ne 'HASH';
1028         #warn "Selected dump : " . Dumper($selected);
1029         my $type = ref $selected;
1030         # Single Object
1031     if ($type and $type ne 'ARRAY') {
1032        return  {$selected->id => 1};
1033     }
1034     # Single Scalar id
1035         elsif (not $type) {
1036                 return { $selected => 1};
1037         }
1038
1039
1040         # Array of objs, arrays, hashes, or just scalalrs.
1041         elsif ($type eq 'ARRAY') {
1042                 my %hashed;
1043                 my $ltype = ref $selected->[0];
1044                 # Objects
1045                 if ($ltype and $ltype ne 'ARRAY')  {
1046                         %hashed = map { $_->id  => 1 } @$selected;
1047         }
1048                 # Arrays of data with id first
1049             elsif ($ltype and $ltype eq 'ARRAY') {
1050                         %hashed = map { $_->[0]  => 1 } @$selected;
1051                 }
1052                 # Hashes using pk or id key
1053                 elsif ($ltype and $ltype eq 'HASH') {
1054                         my $pk = $args->{class}->primary_column || 'id';
1055                         %hashed = map { $_->{$pk}  => 1 } @$selected;
1056                 }
1057                 # Just Scalars
1058         else {
1059                         %hashed = map { $_  => 1 } @$selected;
1060                 }
1061                 return \%hashed;
1062         }
1063         else { warn "AsForm Could not hash the selected argument: $selected"; }
1064 }
1065
1066
1067
1068
1069 =head2 _select_guts
1070
1071 Internal api  method to make the actual select box form elements.
1072
1073 3 types of lists making for --
1074   Hash, Array,
1075   Array of CDBI objects.
1076   Array of scalars ,
1077   Array or  Array refs with cols from class,
1078   Array of hashes
1079
1080 =cut
1081
1082
1083
1084 sub _select_guts {
1085     my ($self, $col, $args) = @_; #$nullable, $selected_id, $values) = @_;
1086
1087     #$args->{stringify} ||=  'stringify_selectbox';
1088     $args->{selected} = _hash_selected($args) if defined $args->{selected};
1089         my $name = $args->{name} || $col;
1090     my $a = HTML::Element->new('select', name => $name);
1091         $a->attr( %{$args->{attr}} ) if $args->{attr};
1092
1093     if ($args->{column_nullable}) {
1094                 my $null_element = HTML::Element->new('option', value => '');
1095         $null_element->attr(selected => 'selected')
1096                 if ($args->{selected}{'null'});
1097         $a->push_content($null_element);
1098     }
1099
1100         my $items = $args->{items};
1101     my $type = ref $items;
1102         my $proto = eval { ref $items->[0]; } || "";
1103         my $optgroups = $args->{optgroups} || '';
1104
1105         # Array of hashes, one for each optgroup
1106         if ($optgroups) {
1107                 my $i = 0;
1108                 foreach (@$optgroups) {
1109                         my $ogrp=  HTML::Element->new('optgroup', label => $_);
1110                         $ogrp->push_content($self->_options_from_hash($items->[$i], $args));
1111                         $a->push_content($ogrp);
1112                         $i++;
1113                 }
1114         }
1115     # Single Hash
1116     elsif ($type eq 'HASH') {
1117         $a->push_content($self->_options_from_hash($items, $args));
1118     }
1119     # Single Array
1120     elsif ( $type eq 'ARRAY' and not ref $items->[0] ) {
1121         $a->push_content($self->_options_from_array($items, $args));
1122     }
1123     # Array of Objects
1124     elsif( $type eq 'ARRAY' and $proto !~ /ARRAY|HASH/i ) {
1125         # make select  of objects
1126         $a->push_content($self->_options_from_objects($items, $args));
1127     }
1128     # Array of Arrays
1129     elsif ( $type eq 'ARRAY' and $proto eq 'ARRAY' ) {
1130         $a->push_content($self->_options_from_arrays($items, $args));
1131     }
1132     # Array of Hashes
1133     elsif ( $type eq 'ARRAY' and $proto eq 'HASH' ) {
1134         $a->push_content($self->_options_from_hashes($items, $args));
1135     }
1136     else {
1137         die "You passed a weird type of data structure to me. Here it is: " .
1138         Dumper($items );
1139     }
1140
1141     return $a;
1142
1143
1144 }
1145
1146 =head2 _options_from_objects ( $objects, $args);
1147
1148 Private method to makes a options out of  objects. It attempts to call each
1149 objects stringify method specified in $args->{stringify} as the content. Otherwise the default stringification prevails.
1150
1151 *Note only  single primary keys supported
1152
1153 =cut
1154 sub _options_from_objects {
1155     my ($self, $items, $args) = @_;
1156         my $selected = $args->{selected} || {};
1157         my $stringify = $args->{stringify} || '';
1158     my @res;
1159         for (@$items) {
1160                 my $opt = HTML::Element->new("option", value => $_->id);
1161                 $opt->attr(selected => "selected") if $selected->{$_->id};
1162                 my $content = $stringify ? $_->stringify :  "$_";
1163                 $opt->push_content($content);
1164                 push @res, $opt;
1165         }
1166     return @res;
1167 }
1168
1169 sub _options_from_arrays {
1170     my ($self, $items, $args) = @_;
1171         my $selected = $args->{selected} || {};
1172     my @res;
1173         my $class = $args->{class} || '';
1174         my $stringify = $args->{stringify} || '';
1175         for my $item (@$items) {
1176             my @pks; # for future multiple key support
1177             push @pks, shift @$item foreach $class->columns('Primary');
1178                 my $id = $pks[0];
1179                 $id =~ s/^0+//;  # In case zerofill is on .
1180                 my $val = defined $id ? $id : '';
1181                 my $opt = HTML::Element->new("option", value =>$val);
1182                 $opt->attr(selected => "selected") if $selected->{$id};
1183
1184                 my $content = ($class and $stringify and $class->can($stringify)) ?
1185                               $class->$stringify($_) :
1186                                   join( '/', map { $_ if $_; }@{$item} );
1187                 $opt->push_content( $content );
1188         push @res, $opt;
1189     }
1190     return @res;
1191 }
1192
1193
1194 sub _options_from_array {
1195     my ($self, $items, $args) = @_;
1196     my $selected = $args->{selected} || {};
1197     my @res;
1198     for (@$items) {
1199                 my $val = defined $_ ? $_ : '';
1200         my $opt = HTML::Element->new("option", value => $val);
1201         #$opt->attr(selected => "selected") if $selected =~/^$id$/;
1202         $opt->attr(selected => "selected") if $selected->{$_};
1203         $opt->push_content( $_ );
1204         push @res, $opt;
1205     }
1206     return @res;
1207 }
1208
1209 sub _options_from_hash {
1210     my ($self, $items, $args) = @_;
1211     my $selected = $args->{selected} || {};
1212     my @res;
1213
1214     my @values = values %$items;
1215     # hash Key is the option content  and the hash value is option value
1216     for (sort keys %$items) {
1217                 my $val = defined $items->{$_} ? $items->{$_} : '';
1218         my $opt = HTML::Element->new("option", value => $val);
1219         #$opt->attr(selected => "selected") if $selected =~/^$id$/;
1220         $opt->attr(selected => "selected") if $selected->{$items->{$_}};
1221         $opt->push_content( $_ );
1222         push @res, $opt;
1223     }
1224     return @res;
1225 }
1226
1227
1228 sub _options_from_hashes {
1229     my ($self, $items, $args) = @_;
1230         my $selected = $args->{selected} || {};
1231         my $pk = eval {$args->{class}->primary_column} || 'id';
1232         my $fclass = $args->{class} || '';
1233         my $stringify = $args->{stringify} || '';
1234         my @res;
1235         for (@$items) {
1236                 my $val = defined $_->{$pk} ? $_->{$pk} : '';
1237                 my $opt = HTML::Element->new("option", value => $val);
1238                 $opt->attr(selected => "selected") if $selected->{$val};
1239                 my $content = ($fclass and $stringify and $fclass->can($stringify)) ?
1240                               $fclass->$stringify($_) :
1241                                   join(' ', @$_);
1242                 $opt->push_content( $content );
1243         push @res, $opt;
1244     }
1245         return @res;
1246 }
1247
1248 # TODO -- Maybe
1249 #sub _to_select_or_create {
1250 #       my ($self, $col, $args) = @_;
1251 #       $args->{name} ||= $col;
1252 #       my $select = $self->to_field($col, 'select', $args);
1253 #       $args->{name} = "create_" . $args->{name};
1254 #       my $create = $self->to_field($col, 'foreign_inputs', $args);
1255 #       $create->{'__select_or_create__'} =
1256 #               $self->to_field('__select_or_create__',{ name => '__select_or_create__' , value => 1 } );
1257 #       return ($select, $create);
1258 #}
1259
1260 #
1261 # checkboxes: if no data in hand (ie called as class method), replace
1262 # with a radio button, in order to allow this field to be left
1263 # unspecified in search / add forms.
1264 #
1265 # Not tested
1266 # TODO  --  make this general checkboxse
1267 #
1268 #
1269 sub _to_checkbox {
1270     my ($self, $col, $args) = @_;
1271     my $nullable = eval {self->column_nullable($col)} || 0;
1272     return $self->_to_radio($col) if !ref($self) || $nullable;
1273     my $value = $self->$col;
1274     my $a = HTML::Element->new("input", type=> "checkbox", name => $col);
1275     $a->attr("checked" => 'true') if $value eq 'Y';
1276     return $a;
1277 }
1278
1279
1280 # TODO  -- make this general radio butons
1281 #
1282 sub _to_radio {
1283     my ($self, $col) = @_;
1284     my $value = ref $self && $self->$col || '';
1285     my $nullable = eval {self->column_nullable($col)} || 0;
1286     my $a = HTML::Element->new("span");
1287     my $ry = HTML::Element->new("input", type=> "radio", name=>$col, value=>'Y' );
1288     my $rn = HTML::Element->new("input", type=> "radio", name=>$col, value=>'N' );
1289     my $ru = HTML::Element->new("input", type=> "radio", name=>$col, value=>'' ) if $nullable;
1290     $ry->push_content('Yes'); $rn->push_content('No');
1291     $ru->push_content('n/a') if $nullable;
1292     if ($value eq 'Y') { $ry->attr("checked" => 'true') }
1293     elsif ($value eq 'N') { $rn->attr("checked" => 'true') }
1294     elsif ($nullable) { $ru->attr("checked" => 'true') }
1295     $a->push_content($ry, $rn);
1296     $a->push_content($ru) if $nullable;
1297     return $a;
1298 }
1299
1300
1301
1302 ############################ HELPER METHODS ######################
1303 ##################################################################
1304
1305 =head2 _rename_foreign_input
1306
1307 _rename_foreign_input($html_el_or_hash_of_them); # changes made by reference
1308
1309 Recursively renames the foreign inputs made by _to_foreign_inputs so they
1310 can be processed generically.  The format is "accessor__AsForeign_colname".
1311
1312 So if an Employee is a Person who has_own  Address and you call
1313
1314   Employee->to_field("person")
1315
1316 then you will get inputs for the Person as well as their Address (by default,
1317 override _field_from_relationship to change logic) named like this:
1318
1319   person__AsForeign__address__AsForeign__street
1320   person__AsForeign__address__AsForeign__city
1321   person__AsForeign__address__AsForeign__state
1322   person__AsForeign__address__AsForeign__zip
1323
1324 And the processor would know to create this address, put the address id in
1325 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.
1326
1327 Overriede make_element_foreign to change how you want a foreign param labeled.
1328
1329 =head2 make_element_foreign
1330
1331   $class->make_element_foreign($accessor, $element);
1332
1333 Makes an HTML::Element type object foreign elemen representing the
1334 class's accessor.  (IE this in an input element for $class->accessor :) )
1335
1336 =cut
1337
1338 sub make_element_foreign {
1339         my ($self, $accssr, $element)  = @_;
1340         $element->attr( name => $accssr . "__AsForeign__" . $element->attr('name'));
1341 }
1342
1343
1344
1345 sub _rename_foreign_input {
1346         my ($self, $accssr, $element) = @_;
1347         if ( ref $element ne 'HASH' ) {
1348         #       my $new_name = $accssr . "__AsForeign__" . $input->attr('name');
1349                 $self->make_element_foreign($accssr, $element);
1350         }
1351         else {
1352                 $self->_rename_foreign_input($accssr, $element->{$_})
1353                         foreach (keys %$element);
1354         }
1355 }
1356 =head2 _box($value)
1357
1358 This functions computes the dimensions of a textarea based on the value
1359 or the defaults.
1360
1361 =cut
1362
1363 our ($min_rows, $max_rows, $min_cols, $max_cols) = (2 => 50, 20 => 100);
1364 sub _box
1365 {
1366     my $text = shift;
1367     if ($text) {
1368         my @rows = split /^/, $text;
1369         my $cols = $min_cols;
1370         my $chars = 0;
1371         for (@rows) {
1372             my $len = length $_;
1373             $chars += $len;
1374             $cols = $len if $len > $cols;
1375             $cols = $max_cols if $cols > $max_cols;
1376         }
1377         my $rows = @rows;
1378         $rows = int($chars/$cols) + 1 if $chars/$cols > $rows;
1379         $rows = $min_rows if $rows < $min_rows;
1380         $rows = $max_rows if $rows > $max_rows;
1381         ($rows, $cols)
1382     }
1383     else { ($min_rows, $min_cols) }
1384 }
1385
1386
1387 1;
1388
1389
1390 =head1 CHANGES
1391
1392 =head1 MAINTAINER
1393
1394 Maypole Developers
1395
1396 =head1 AUTHORS
1397
1398 Peter Speltz, Aaron Trevena
1399
1400 =head1 AUTHORS EMERITUS
1401
1402 Simon Cozens, Tony Bowden
1403
1404 =head1 TODO
1405
1406   Documenting
1407   Testing - lots
1408   chekbox generalization
1409   radio generalization
1410   select work
1411   Make link_hidden use standard make_url stuff when it gets in Maypole
1412   How do you tell AF --" I want a has_many select box for this every time so,
1413      when you call "to_field($this_hasmany)" you get a select box
1414
1415 =head1 BUGS and QUERIES
1416
1417 Please direct all correspondence regarding this module to:
1418  Maypole list.
1419
1420 =head1 COPYRIGHT AND LICENSE
1421
1422 Copyright 2003-2004 by Simon Cozens / Tony Bowden
1423
1424 This library is free software; you can redistribute it and/or modify
1425 it under the same terms as Perl itself.
1426
1427 =head1 SEE ALSO
1428
1429 L<Class::DBI>, L<Class::DBI::FromCGI>, L<HTML::Element>.
1430
1431 =cut
1432