File Coverage

blib/lib/XHTML/Instrumented/Form.pm

Criterion	Covered	Total	%
statement	18	147	12.2
branch	0	60	0.0
condition	0	16	0.0
subroutine	6	25	24.0
pod	18	18	100.0
total	42	266	15.7

use strict;
use warnings;

package XHTML::Instrumented::Form;

our $VERSION = '0.09';

use XHTML::Instrumented::Form::Control;
use XHTML::Instrumented::Form::Select;

use Params::Validate qw( validate SCALAR BOOLEAN HASHREF OBJECT ARRAYREF );

use Carp qw (croak carp);

=head1 NAME

XHTML::Instramented::Form - XHTML::Instramented Form Object

=head1 SYNOPSIS

my $template = XHTML::Instrumented->new(name => 'bob');

my $form = $template->get_form(name => 'myform');

=head1 API

=head2 Constructor

=over

=item new

=back

=cut

sub new
{
    my $class = shift;

    my %p = validate(
       @_, {
          action => 0,
          id => 0,
          required => 0,
          name => 0,
          method => 0,
       }
    );

    bless { %p }, $class;
}

sub add_params
{
    my $self = shift;

    $self->{params} = { @_ };

    for my $name (keys %{$self->{params}}) {
        my $element = $self->get_element($name);
	next unless $element;

	$element->set_value($self->{params}{$name});
    }
}

sub add_defaults
{
    my $self = shift;

    $self->{defaults} = { @_ };

    for my $name (keys %{$self->{defaults}}) {
        my $element = $self->get_element($name);
	if ($element) {
	    $element->set_default($self->{defaults}{$name});
	} else {
	    warn 'add defaults ' . $name;
	}
    }
}

sub element_values
{
    my $self = shift;
    my $key = shift or die;

    my @ret;
    @ret = @{ $self->{defaults}{$key} || [] };

    if ($self->{params}{$key}) {
	@ret = @{$self->{params}{$key} || []};
    }

    @ret;
}

sub element_value
{
    my $self = shift;
    my $key = shift or die;

    my @ret;
    @ret = ($self->{defaults}{$key});

    if ($self->{params}{$key}) {
	@ret = @{$self->{params}{$key} || []};
    }

    $ret[0];
}

sub _control
{
    my $self = shift;

    bless { self => $self, }, 'XHTML::Instrumented::Form::Control';
}

sub set_select_data
{
    my $self = shift;
    my %p = validate(@_, {
        name => 1,
	data => ARRAYREF,
    });

    my $select = $self->get_element($p{name});

    croak('No select element found: ' . $p{name}) unless $select;

    $select->set_select_data(@{$p{data}});
}

sub delete_element
{
    my $self = shift;
    my %p = validate(@_,
        {
	    name => 1,
	}
    );
    my $name = $p{name} or die 'No name for element';
    my $ret = $self->{elements}->{$name};
    delete $self->{elements}->{$name};

    return $ret;
}

sub add_element
{
    my $self = shift;
    my %p = validate(@_,
        {
	    name => 1,
	    type => 1,
	    required => 0,
	    optional => 0,
	    default => 0,
	    value => 0,
	    data => 0,
	    values => 0,
	    multiple => 0,
	    remove => 0,
	    onclick => 0,
	    onchange => 0,
	    class => 0,
	    package => {
	        optional => 1,
		isa => 'XHTML::Instrumented::Form::ElementControl',
	    },
	}
    );
    my $name = $p{name} or die 'No name for element';

    if ($self->{elements}->{$name}) {
	die "element $name already defined";
    }

    $p{type} ||= 'text';

    if (my $package = $p{package}) {
        delete $p{package};
	$self->{elements}->{$name} = $package->new(%p);
    } elsif ($p{type} eq 'multiselect' or $p{type} eq 'checkbox') {
	require XHTML::Instrumented::Form::Checkbox;
	$self->{elements}->{$name} = XHTML::Instrumented::Form::Checkbox->new(%p);
    } elsif ($p{type} eq 'select') {
	require XHTML::Instrumented::Form::Select;
	$self->{elements}->{$name} = XHTML::Instrumented::Form::Select->new(%p);
    } elsif ($p{type} eq 'hidden') {
	require XHTML::Instrumented::Form::Hidden;
	$self->{elements}->{$name} = XHTML::Instrumented::Form::Hidden->new(%p);
    } else {
	require XHTML::Instrumented::Form::Element;
	$self->{elements}->{$name} = XHTML::Instrumented::Form::Element->new(%p);
    }

    $self->{elements}->{$name};
}

sub set_element
{
    my $self = shift;
    my $args = { @_ };

    my $name = $args->{name} or die 'No name for element';

    my $element = $self->{elements}->{$name};

    for my $key (keys %$args) {
	$element->{$key} = $args->{$key};
    }

    return $element;
}

sub args
{
    my $self = shift;

    %{$self->{elements} || {}};
}

sub params
{
    my $self = shift;
    my $hash = {};
die;
    $hash->{action} = $self->{action} if $self->{action};
    $hash->{method} = $self->{method} if $self->{method};

    $hash;
}

sub context
{
    {
        action => 'bob',
    };
}

sub is_select
{
    my $self = shift;
    my $id = shift || die 'no id.';
    my $ret = 0;
    if (my $element = $self->{elements}{$id}) {
        if ($element->{type} eq 'select') {
            for my $data (@{$element->{data}}) {
		if (defined($data->{value}) && defined($self->element_value($id))
		 && $self->element_value($id) eq $data->{value}) {
		    $data->{selected} = 'selected';
		}
	    }
	}
	[ @{$element->{data}} ];
    } else {
        [];
    }
}

sub get_element
{
    my $self = shift;
    my $name = shift;

    my $ret = $self->{elements}{$name};

    if ($ret) {
	$ret->{_default} = $self->element_value($name);
	$ret->{default} ||= $self->element_value($name);
    }

    return $ret;
}

sub is_element
{
    my $self = shift;
    my $args = { @_ };
    my $ret = 0;

    if (my $name = $args->{name}) {
        if ($self->{elements}{$name}) {
	    $ret = 1;
	}
    }
    $ret;
}

sub auto
{
    my $self = shift;
    my @ret;

    for my $element (keys %{$self->{elements}}) {
        next unless $self->{elements}{$element}{type} eq 'hidden';
	my $x = $self->get_element($element);

	if (ref($x->{value}) eq 'ARRAY') {
	    push(@ret, map({bless({ type => 'hidden', name => $x->{name}, value => $_ }, ref($x) );} @{$x->{value}} ));
	} else {
	    unless (defined $x->{value}) {
		$x->{value} = $self->element_value($element);
	    }
	    push(@ret, $x);
	}
    }

    @ret;
}

sub update_argumants
{
    my $self = shift;
    my $args = { @_ };

    $args->{args};
}

sub name
{
    my $self = shift;

    $self->{name};
}


1;
__END__