package Class::DBI::AsForm;
use 5.006;
use strict;
use warnings;
use Class::DBI::Plugin::Type (); # Bug  -- column_type returns char for enum cols
                                 # Use column_type in model class instead 

use Data::Dumper;  # pjs for 
use Class::DBI::mysql ();
our $OLD_STYLE = 0;

use HTML::Element;
require Exporter;
our @ISA = qw(Exporter);
# PETER SPELTZ --  Added new "_to_*" methods to @EXPORT 
our @EXPORT = qw( to_cgi to_field _to_textarea _to_textfield _to_select
type_of _to_foreign_inputs _to_enum_select _to_bool_select ); 
our $VERSION = '2.3';

=head1 NAME

Class::DBI::AsForm  
Produce HTML form elements for database columns

=head1 SYNOPSIS

    package Music::CD;
    use Class::DBI::AsForm;
    use base 'Class::DBI';
    use CGI;
    ...

    sub create_or_edit {
        my $class = shift;
        my %cgi_field = $class->to_cgi;
        return start_form,
               (map { "<b>$_</b>: ". $cgi_field{$_}->as_HTML." <br>" } 
                    $class->Columns),
               end_form;
    }

    # <form method="post"...>
    # Title: <input type="text" name="Title" /> <br>
    # Artist: <select name="Artist"> 
    #           <option value=1>Grateful Dead</option>
    #           ...
    #         </select>
    # ...
    # </form>

=head1 DESCRIPTION

This module helps to generate HTML forms for creating new database rows
or editing existing rows. It maps column names in a database table to
HTML form elements which fit the schema. Large text fields are turned
into textareas, and fields with a has-a relationship to other
C<Class::DBI> tables are turned into select drop-downs by default 
to select a row from the joined class. Also enum and boolean  columns 
are made into select boxes.


=head1 METHODS

The module is a mix-in which adds two additional methods to your
C<Class::DBI>-derived class. 

=head2 to_cgi

This returns a hash mapping all the column names of the class to
HTML::Element objects representing form widgets.

=cut

sub to_cgi {
    my $class = shift;
    map { $_ => $class->to_field($_) } $class->columns;
}

=head2 to_field($field [, $how])

This maps an individual column to a form element. The C<how> argument
can be used to force the field type into one of C<textfield>, C<textarea>
or C<select>; you can use this is you want to avoid the automatic detection
of has-a relationships. 

=cut

=head1 ***NEW**** GETTING SPECIFIC IN MODEL CLASS 

You can tell AsForm some things in your model classes to get custom results. In particular you can have:

=head2 Custom column_type methods

Since much of this methods functionality relies on the subroutine C<column_type>
returning the type string from the database table definition Model classes can benefit a great deal by writing their own. See example.  This version tries to call column_type with the model class. IF your model's column_type returns undef or it has no such method it falls back on C<&Class::DBI::Plugin::Type::column_type> which is database independent but not fully functional yet. For full functionality make a custom C<column_type> method in your base model class and override it in subclasses at will. Some Class::DBI::**** drivers such as Class::DBI::mysql have mostly functional ones.  

You can set bool options for users , make select boxes for ordinary columns (by lying and returning an enum('blah', 'blh') string, get correct types for is_a inherited columns, optimize , and maybe more.

=head2 Inputs for the has_a class rather than a select box every time.

We've all probably wanted this at one time or another. In your model class make a has_a_new sub to tell AsForm you want to create a new one of these Foos for this object rather than select from existing ones. This example gets inputs for the specified adress columns and ALL email columns.  Specifying the columns makes this sub handy to have in Templates as they can use C<class.has_a_new.address> to find out what inputs and in what order you want from the has_a class on your form.

    Customer->has_a(address => "Address");
    Customer->has_a(email   => "Email");
	sub has_a_new { { 
		address => [ qw/street city state zip/ ], # elements for these cols 
	 	email   => [], # ALL 
	}

Then when you call C<Customer->to_cgi>, instead of a single element in the 'address' and email slots, you will have a hashref of elements. *NOTE -- NO attempt is made to handle column name overlaps. You can do that in the templates easily however as you know that columns in the address hash are all from the address table.This works for calls with objects too so you can edit your address and email  objects on the Customer form. 
	
=head2 Appropriate elements for columns inherited from an is_a relationship

At least you have the power to get them by making column_type work.

=head2 Select box specifications for has_a columns.

You can specify columns to be selected for a select box for a class by :

	__Package__->columns('SelectBox' => qw/col1 col2/);

If you don't, 'Stringify' columns are used if they exist and lastly 'Essential' columns. The 'Primary' column is always pushed to front of list and is then popped off to become the option value.  This means don't include it in the 'SelectBox' columns unless you want it in the option content. 

You can limit rows selected for the select box with a has_a_select_limit sub like so:

	Customer->has_a(pay_plan => "PayPlan");
	Customer->has_a(pick_fromTopFive  => "Movie"
	sub has_a_select_limit { {
	 	pay_plan            => "WHERE is_available = 1", 
	  	pick_fromTopFive    => "ORDER BY rank ASC LIMIT 5" }
	}

If you need complex stringification make a C<stringify_selectbox> sub which takes an arrayref. Elements are in order specified in columns('SelectBox') or whatever columns list was used. 

=cut

# TODO -- perhaps call to field with is_a object if is_a col.
# possible problem if is_a is mapped to primary key in calling class
sub to_field {
    my ($self, $field, $how) = @_;
    my $class = ref $self || $self;


    if ($how and $how =~ /^(text(area|field)|select)$/) {
        no strict 'refs';
        my $meth = "_to_$how";
		# pjs -- changed to self so values can be gotten if exists
        return $self->$meth($field);
    }

	#NOTE -- if its a inherited column (from is_a) this has_a check will fail
	# What should it do? 
	# Workaround is to define has_a for inherited column in sub class 
    my $hasa = $class->__hasa_rels->{$field};
	my $hasa_class;
	$hasa_class = $hasa->[0] 
		if defined $hasa and $hasa->[0]->isa("Class::DBI");

	# This whole mess could probably benifit from a design pattern. 
	# Chain  of Command? 
	return $self->_to_foreign_inputs($field, $hasa_class)
    	if ( $hasa_class and eval{ $class->has_a_new->{$field} });

    return $self->_to_select($field, $hasa->[0])
		if $hasa_class;

	# Try model class's column_type first
    my $type = eval {$class->column_type($field);};
	unless ($type) {
    	# Right, have some of this!
    	eval "package $class; Class::DBI::Plugin::Type->import()";
    	$type = $class->column_type($field);
	}

	# putting above in sub get error: no method column_type in Class::DBI::Column
	#my $type = get_column_type($field);
											   
    return $self->_to_textarea($field)
        if $type and $type =~ /^(TEXT|BLOB)$/i;

	return $self->_to_enum_select($field, $type)  
		if ($type and  $type =~ /^ENUM\((.*?)\)$/i ); 
	
	return $self->_to_bool_select($field, $type)
		if ($type and  $type =~ /^BOOL/i ); 
		
    return $self->_to_textfield($field);

}

sub _to_textarea {
    my ($self, $col) = @_;
    my $a = HTML::Element->new("textarea", name => $col);
    if (ref $self) { $a->push_content($self->$col) }
    $OLD_STYLE && return $a->as_HTML;
    $a;
}

sub _to_textfield {
    my ($self, $col) = @_;
    my $value = ref $self && $self->$col;
    my $a = HTML::Element->new("input", type=> "text", name => $col);
    $a->attr("value" => $value) if $value;
    $OLD_STYLE && return $a->as_HTML;
    $a;
}

# Peter Speltz -- 
# Rewrote this to be efficient. No object creation. 
# Also, added option for CDBI classes to specify a limiting clause
# via "has_a_select_limit". 
sub _to_select {
    my ($self, $col, $hint) = @_;
    my $has_a_class = $hint || $self->__hasa_rels->{$col}->[0];
	
	# Possible sql limiting clause ("WHERE acol = 'X' " or "LIMIT 10", etc) 
	my $select_box_limit = eval { $self->has_a_select_limit->{$col} } ;  

	# Get columns to appear in select box options on forms. 
	# TODO -- there is maybe a good idiom for this.
	my @select_box_cols;
	@select_box_cols = $has_a_class->columns('SelectBox');
	@select_box_cols = $has_a_class->columns('Stringify') unless @select_box_cols;
	@select_box_cols = $has_a_class->_essential unless @select_box_cols;
	unshift @select_box_cols, $has_a_class->columns('Primary'); 
	

	my $sql = "SELECT " . join( ', ', @select_box_cols) . " FROM " . 
		      $has_a_class->table . " " . $select_box_limit;

#warn "select box cols = @select_box_cols ";
#warn "sql is $sql";
	
	my $opts_data = $self->db_Main->selectall_arrayref($sql); 
#warn Dumper($opts_data);
	
    my $a = HTML::Element->new("select", name => $col);
    for (@$opts_data) { 
		# id better be first element
		my $id = shift @$_;
        my $opt = HTML::Element->new("option", value => $id );
        $opt->attr("selected" => "selected") if ref $self 
                                                and eval { $id eq $self->$col->id };
		# TODO -- maybe modify stringify_self to be class meth and take array
		my $content = eval {$has_a_class->stringify_selectbox(@$_);} || 
					  join(' ', @$_);
        $opt->push_content( $content );
        $a->push_content($opt);
    }
    $OLD_STYLE && return $a->as_HTML;
    $a;
}

# Peter Speltz -- makes select inputs for enum column
# TODO check other DB enum forms
# This expects enum col type format like mysql -- enum('val', 'otherval', ...)
sub _to_enum_select {
    my ($self, $col, $type) = @_;
	$type =~ /ENUM\((.*?)\)/i;
	(my $enum = $1) =~ s/'//g;
	my @enum_vals = split /,/, $enum;

    my $a = HTML::Element->new("select", name => $col);
    for ( @enum_vals ) { 
        my $sel = HTML::Element->new("option", value => $_); 
        $sel->attr("selected" => "selected") if ref $self 
                                                and eval { $self->$col eq $_ };
        $sel->push_content($_); 
        $a->push_content($sel);
    }
    $OLD_STYLE && return $a->as_HTML;
    $a;
}

# Peter Speltz -- This  makes select input for boolean column
# $type = "bool('zero_string', 'one_string')". Default strings are "No", "Yes". 
sub _to_bool_select {
    my ($self, $col, $type) = @_;
	my @bool_text = ('No', 'Yes');	
	if ($type =~ /BOOL\((.+?)\)/i) {
		(my $bool = $1) =~ s/'//g;
		@bool_text = split /,/, $bool;
	}

	#TODO get default for column and use it instaed of  -----------
	my $myselected = ref $self ? eval {$self->$col;} : $bool_text[2];

    my $a = HTML::Element->new("select", name => $col);
    my $opt0 = HTML::Element->new("option", value => 0); 
    $opt0->attr("selected" => "selected") if $myselected eq 0; 
    $opt0->push_content($bool_text[0]); 
    $a->push_content($opt0);

    my $opt1 = HTML::Element->new("option", value => 1); 
    $opt1->attr("selected" => "selected") if $myselected eq 1; 
    $opt1->push_content($bool_text[1]); 
    $a->push_content($opt1);

    $OLD_STYLE && return $a->as_HTML;
    $a;
}

# Peter Speltz --
# This just calls to_field with foreign class for the columns defined in
# has_a_new or $class->columns. It returns hashref of the input elements 
sub _to_foreign_inputs {
	my ($self, $col, $hasa_classORobj) = @_;
	my @foreign_fields = @{$self->has_a_new->{$col}};
	@foreign_fields = $hasa_classORobj->columns unless @foreign_fields;

	# get the foreign object if we can
	if (ref $self) {
		my $id = $self->$col->id ;
		my $foreign_obj = $hasa_classORobj->retrieve($self->$col->id);
		$hasa_classORobj = $foreign_obj if $foreign_obj;
	}

	my %result = map { $_ => $hasa_classORobj->to_field($_) } @foreign_fields;
	return \%result;
}


# this gives error and i have no idea why
sub get_column_type {
	my ($class, $field) = @_;
	# Try model class's column_type first
    my $type = eval {$class->column_type($field);};
	unless ($type) {
    	# Right, have some of this!
    	eval "package $class; Class::DBI::Plugin::Type->import()"; # gives err
		# no column_type mehtod in Class::DbI::Column
    	$type = $class->column_type($field);
	}
	$type;
}

####################################################

# Preloaded methods go here.

1;

=head1 CHANGES

Version 1.x of this module returned raw HTML instead of C<HTML::Element>
objects, which made it harder to manipulate the HTML before sending it
out. If you depend on the old behaviour, set C<$Class::DBI::AsForm::OLD_STYLE>
to a true value.

***** New ***** Changes  

1. 	to_field now trys to use model classes column_type sub and if it results in 
	undef, then uses Class::DBI::Plugin::Type	

2.  to_select creates no objects to be efficient. You can specify columns retrieved for select box with C<__PACKAGE__->columns('SelectBox'=> qw/blah dah doo/); To stringify the option, it tries C<$class->stringify_selectbox> and just joins columns on ' ' if that fails.

3. One can now limit rows selected for has_a select boxes with a has_a_select_limit sub in your model class.

4. _to_foreign_inputs -- You can get inputs for has_a cols rather than select box. Specify which has_a columns to do this for in a  has_a_new sub.

5. _to_enum_select -- select box for enum columns

6. _to_bool_select -- select box for bool columns. Options user sees can be specified in the $type string returned from column_type. Examples: 
	
	BOOL('No','Yes') 
	BOOL('Off', 'On')

I may have left something out. 

********************************************

=head1 AUTHOR

Simon Cozens, C<simon@cpan.org>

=head1 SEE ALSO

L<Class::DBI>, L<Class::DBI::FromCGI>, L<HTML::Element>.

=cut