Mozilla::Mechanize::Form - Mimic L<HTML::Form>

package Mozilla::Mechanize::Form;
use strict;
use warnings;

# $Id: Form.pm,v 1.4 2005/10/07 12:17:24 slanning Exp $

use Mozilla::Mechanize::Input;

sub new {
    my $class = shift;
    my $node = shift;
    my $moz = shift;

    # turn the Node into an HTMLFormElement
    my $form = $node->QueryInterface(Mozilla::DOM::HTMLFormElement->GetIID);

    my $self = { form => $form };
    $self->{moz} = $moz if defined $moz;
    bless($self, $class);
}

sub method {
    my $self = shift;
    my $val = shift;
    my $form = $self->{form};
    $form->SetMethod($val) if defined $val;
    my $method = $form->GetMethod;

    # XXX: provide default value (not sure about this...)
    $method = 'GET' unless $method =~ /\S/;
    return $method;
}

sub action {
    my $self = shift;
    my $val = shift;
    my $form = $self->{form};
    $form->SetAction($val) if defined $val;
    # This is supposed to be required in HTML 4.01
    return $form->GetAction;
}

sub enctype {
    my $self = shift;
    my $val = shift;
    my $form = $self->{form};
    $form->SetEnctype($val) if defined $val;
    my $enctype = $form->GetEnctype;

    # XXX: provide default value (not sure about this...)
    $enctype = 'application/x-www-form-urlencoded' unless $enctype =~ /\S/;
    return $enctype;
}

sub name {
    my $self = shift;
    my $val = shift;
    my $form = $self->{form};
    $form->SetName($val) if defined $val;
    return $form->GetName;
}

sub attr {
    my $self = shift;
    return unless @_;
    my $name = shift;
    my $form = $self->{form};

    my ($attr) = grep $name =~ /^$_$/i, qw(AcceptCharset Action Enctype Method Name Target);
    return unless defined $attr;

    my $method = "Set$attr";
    $form->$method(shift) if @_;
    $method = "Get$attr";
    my $val = $form->$method;

    # Defaults for non-present attributes
    unless ($val =~ /\S/) {
        $val = 'GET' if $attr eq 'Method';
        $val = 'application/x-www-form-urlencoded' if $attr eq 'Enctype';
        # action is supposed to be required in HTML 4.01
    }

    return $val;
}

{
    # Recursively get input elements. This is necessary in order
    # to preserve their order. (cf. _extract_links, _extract_images in Mechanize.pm)
    my (@inputs, %radio_seen);

    sub inputs {
        my ($self, $subelement) = @_;   # 2nd arg is undocumented
        my $node;

        # The first time, it's called with no subelement
        if (defined $subelement) {
            $node = $subelement;
        } else {
            @inputs = ();
            %radio_seen = ();
            $node = $self->{form};
        }

        # If it's an input element, get it; otherwise, recurse if has children
        if ($node->GetNodeName =~ /^(input|button|select|textarea)$/i) {
            my $tagname = lc $1;
            if ($tagname eq 'input') {
                my $input = $node->QueryInterface(Mozilla::DOM::HTMLInputElement->GetIID);
                my $name = lc $input->GetName;
                my $type = lc $input->GetType;
                # For some reason, we only get the first in a radio group
                unless ($type eq 'radio' and $radio_seen{$name}++) {
                    push @inputs, Mozilla::Mechanize::Input->new($node, $self->{moz});
                }
            } else {
                push @inputs, Mozilla::Mechanize::Input->new($node, $self->{moz});
            }
            $self->debug("added '$tagname' input");
        } elsif ($node->HasChildNodes) {
            my @children = $node->GetChildNodes;
            # skips #text nodes
            foreach my $child (grep {$_->GetNodeName !~ /^#/} @children) {
                $self->inputs($child);
            }
        }

        # Continue only at the top-level
        return if defined $subelement;

        return wantarray ? @inputs : scalar @inputs;
    }
}

sub find_input {
    my $self = shift;
    my( $name, $type, $index ) = @_;

    my $form = $self->{form};

    my $typere = qr/.*/;
    $type and $typere = $type =~ /^select/i ? qr/^$type/i : qr/^$type$/i;

    if ( wantarray ) {
        my( $cnt, @res ) = ( 0 );
        for my $input ( $self->inputs ) {
            if ( defined $name ) {
                $input->name or next;
                $input->name ne $name and next;
            }

            $input->type =~ $typere or next;
            $cnt++;
            $index && $index ne $cnt and next;
            push @res, $input;
        }
        return @res;
    } else {
        $index ||= 1;
        for my $input ( $self->inputs ) {
            if ( defined $name ) {
                $input->name or next;
                $input->name ne $name and next;
            }
            $input->type =~ $typere or next;
            --$index and next;
            return $input;
        }
        return undef;
    }
}

sub value {
    my $self = shift;
    my $input = $self->find_input( shift );
    return $input->value( @_ );
}

sub submit {
    my $self = shift;
    my $form = $self->{form};
    $form->Submit();

    # XXX: if they didn't pass $moz to `new', they're stuck..
    my $moz = $self->{moz} || return;
    $moz->_wait_while_busy();
}

sub reset {
    my $self = shift;
    my $form = $self->{form};
    $form->Reset();

    # XXX: if they didn't pass $moz to `new', they're stuck..
    my $moz = $self->{moz} || return;
    $moz->_wait_while_busy();
}

sub _radio_group {
    my $self = shift;
    my $form = $self->{form};

    my $name = shift or return;
    my @rgroup;

    my @inputs = $form->GetElementsByTagName('input');
    my $iid = Mozilla::DOM::HTMLInputElement->GetIID;
    foreach my $input (map {$_->QueryInterface($iid)} @inputs) {
        next unless lc($input->GetType) eq 'radio';
        next unless lc($input->GetName) eq lc($name);
        push @rgroup, $input;
    }

    return wantarray ? @rgroup : \@rgroup;
}

sub debug {
    my ($self, $msg) = @_;
    my (undef, $file, $line) = caller();
    print STDERR "$msg at $file line $line\n" if $self->{debug};
}


1;

__END__