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