view release on metacpan or  search on metacpan

lib/CGI/Test/Form.pm  view on Meta::CPAN

    foreach my $w ($this->widget_list)
    {
        $w->reset_state;
    }
    return;
}

######################################################################
#
# ->submit
#
# Submit this form.
# Returns resulting CGI::Test::Page.
#
######################################################################
sub submit
{
    my $this = shift;

    my $method = $this->method;
    my $input  = $this->_output;    # Input to the request we're about to make
    my $action = $this->_action_url;
    my $page   = $this->page;
    my $server = $page->server;
    my $result;

    if ($method eq "GET")
    {
        confess "GET requests only allowed URL encoding, not %s",
          $input->mime_type
          unless $input->mime_type eq "application/x-www-form-urlencoded";

        $action->query($input->data);
        $result = $server->GET($action->as_string, $page->user);
    }
    elsif ($method eq "POST")
    {
        $result = $server->POST($action->as_string, $input, $page->user);
    }
    else
    {
        confess "unsupported method $method for FORM action";
    }

    return $result;
}

######################################################################
#
# ->_xtract
#
# Widget extraction routine: traverse the <FORM> tree and create an instance
# of CGI::Test::Form::Widget per encountered widget.  The dynamic type depends
# on the widget type, e.g. a button creates a CGI::Test::Form::Widget::Button
# object.
#
# Widgets are also sorted by type, and stored as object attribute:
#
#   buttons         all buttons
#	inputs        	text area, text fields, password fields
#	menus		    popup menus
#	radios		  	radio buttons
#	checkboxes	  	all checkboxes
#	hidden          all hidden fields
#	widgets         all widgets, whatever their type.
#
# The special attribute `radio_groups' is only built when there is at least
# one radio button.
#
# Although we extract ALL the widgets, caller is only interested in a
# specific list, given in $which.  Therefore, returns a list ref on that
# particular set.
#
######################################################################
sub _xtract
{
    my $this = shift;
    my ($which) = @_;

    #
    # Initiate traversal to locate all widgets nodes.
    #

    my %is_widget = map {$_ => 1} qw(input textarea select button isindex);
    my @wg = $this->tree->look_down(sub {$is_widget{$_[ 0 ]->tag}});

    #
    # Initialize all lists to be empty
    #

    for my $attr ( qw(buttons inputs radios checkboxes hidden menus widgets) )
    {
        $this->{$attr} = [];
    }

    #
    # And now sort them out.
    #

    my %input = (    #  [ class name,		 attribute ]
                  "submit"   => [ 'Button::Submit',    "buttons" ],
                  "reset"    => [ 'Button::Reset',     "buttons" ],
                  "image"    => [ 'Button::Image',     "buttons" ],
                  "text"     => [ 'Input::Text_Field', "inputs" ],
                  "file"     => [ 'Input::File',       "inputs" ],
                  "password" => [ 'Input::Password',   "inputs" ],
                  "radio"    => [ 'Box::Radio',        "radios" ],
                  "checkbox" => [ 'Box::Check',        "checkboxes" ],
                  "hidden"   => [ 'Hidden',            "hidden" ],
                  );

    my %button = (    #  [ class name,		 attribute ]
                   "submit" => [ 'Button::Submit', "buttons" ],
                   "reset"  => [ 'Button::Reset',  "buttons" ],
                   "button" => [ 'Button::Plain',  "buttons" ],
                   );

    my $wlist = $this->{widgets};    # All widgets also inserted there

    foreach my $node (@wg)
    {