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