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