t/form.t - metacpan.org

#!perl -w

use strict;
use Test qw(plan ok);

plan tests => 127;

use HTML::Form;

my @warn;
$SIG{__WARN__} = sub { push(@warn, $_[0]) };

my @f = HTML::Form->parse("", "http://localhost/");
ok(@f, 0);

@f = HTML::Form->parse(<<'EOT', "http://localhost/");
<form action="abc" name="foo">
<input name="name">
</form>
<form></form>
EOT

ok(@f, 2);

my $f = shift @f;
ok($f->value("name"), "");
ok($f->dump, "GET http://localhost/abc [foo]\n  name=                          (text)\n");

my $req = $f->click;
ok($req->method, "GET");
ok($req->uri, "http://localhost/abc?name=");

$f->value(name => "Gisle Aas");
$req = $f->click;
ok($req->method, "GET");
ok($req->uri, "http://localhost/abc?name=Gisle+Aas");

ok($f->attr("name"), "foo");
ok($f->attr("method"), undef);

$f = shift @f;
ok($f->method, "GET");
ok($f->action, "http://localhost/");
ok($f->enctype, "application/x-www-form-urlencoded");
ok($f->dump, "GET http://localhost/\n");

# try some more advanced inputs
$f = HTML::Form->parse(<<'EOT', base => "http://localhost/", verbose => 1);
<form method=post>
   <input name=i type="image" src="foo.gif">
   <input name=c type="checkbox" checked>
   <input name=r type="radio" value="a">
   <input name=r type="radio" value="b" checked>
   <input name=t type="text">
   <input name=p type="PASSWORD">
   <input name=tel type="tel">
   <input name=date type="date">
   <input name=h type="hidden" value=xyzzy>
   <input name=s type="submit" value="Doit!">
   <input name=r type="reset">
   <input name=b type="button">
   <input name=f type="file" value="foo.txt">
   <input name=x type="xyzzy">

   <textarea name=a>
abc
   </textarea>

   <select name=s>
      <option>Foo
      <option value="bar" selected>Bar
   </select>

   <select name=m multiple>
      <option selected value="a">Foo
      <option selected value="b">Bar
   </select>
</form>
EOT

#print $f->dump;
#print $f->click->as_string;

ok($f->click->as_string, <<'EOT');
POST http://localhost/
Content-Length: 86
Content-Type: application/x-www-form-urlencoded

i.x=1&i.y=1&c=on&r=b&t=&p=&tel=&date=&h=xyzzy&f=&x=&a=%0D%0Aabc%0D%0A+++&s=bar&m=a&m=b
EOT

ok(@warn, 1);
ok($warn[0] =~ /^Unknown input type 'xyzzy'/);
@warn = ();

$f = HTML::Form->parse(<<'EOT', "http://localhost/");
<form>
   <input type=submit value="Upload it!" name=n disabled>
   <input type=image alt="Foo">
   <input type=text name=t value="1">
</form>
EOT

#$f->dump;
ok($f->click->as_string, <<'EOT');
GET http://localhost/?x=1&y=1&t=1

EOT

# test file upload
$f = HTML::Form->parse(<<'EOT', "http://localhost/");
<form method=post enctype="MULTIPART/FORM-DATA">
   <input name=f type=file value="/etc/passwd">
   <input type=submit value="Upload it!">
</form>
EOT

#print $f->dump;
#print $f->click->as_string;

ok($f->click->as_string, <<'EOT');
POST http://localhost/
Content-Length: 0
Content-Type: multipart/form-data; boundary=none

EOT

my $filename = sprintf "foo-%08d.txt", $$;
die if -e $filename;

open(FILE, ">$filename") || die;
binmode(FILE);
print FILE "This is some text\n";
close(FILE) || die;

$f->value(f => $filename);

#print $f->click->as_string;

ok($f->click->as_string, <<"EOT");
POST http://localhost/
Content-Length: 139
Content-Type: multipart/form-data; boundary=xYzZY

--xYzZY\r
Content-Disposition: form-data; name="f"; filename="$filename"\r
Content-Type: text/plain\r
\r
This is some text
\r
--xYzZY--\r
EOT

unlink($filename) || warn "Can't unlink '$filename': $!";

ok(@warn, 0);

# Try to parse form HTTP::Response directly
{
    package MyResponse;
    use vars qw(@ISA);
    require HTTP::Response;
    @ISA = ('HTTP::Response');

    sub base { "http://www.example.com" }
}
my $response = MyResponse->new(200, 'OK');
$response->content("<form><input type=text value=42 name=x></form>");

$f = HTML::Form->parse($response);

ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=42

EOT

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
   <input type=checkbox name=x> I like it!
</form>
EOT

$f->find_input("x")->check;

ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=on

EOT

$f->value("x", "off");
ok($f->click->as_string, <<"EOT");
GET http://www.example.com

EOT

$f->value("x", "I like it!");
ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=on

EOT

$f->value("x", "I LIKE IT!");
ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=on

EOT

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
<select name=x>
   <option value=1>one
   <option value=2>two
   <option>3
</select>
<select name=y multiple>
   <option value=1>
</select>
</form>
EOT

$f->value("x", "one");

ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=1

EOT

$f->value("x", "TWO");
ok($f->click->as_string, <<"EOT");
GET http://www.example.com?x=2

EOT

ok(join(":", $f->find_input("x")->value_names), "one:two:3");
ok(join(":", map $_->name, $f->find_input(undef, "option")), "x:y");

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
<input name=x value=1 disabled>
<input name=y value=2 READONLY type=TEXT>
<input name=z value=3 type=hidden>
</form>
EOT

ok($f->value("x"), 1);
ok($f->value("y"), 2);
ok($f->value("z"), 3);
ok($f->click->uri->query, "y=2&z=3");

my $input = $f->find_input("x");
ok($input->type, "text");
ok(!$input->readonly);
ok($input->disabled);
ok($input->disabled(0));
ok(!$input->disabled);
ok($f->click->uri->query, "x=1&y=2&z=3");

$input = $f->find_input("y");
ok($input->type, "text");
ok($input->readonly);
ok(!$input->disabled);
$input->value(22);
ok($f->click->uri->query, "x=1&y=22&z=3");

$input->strict(1);
eval {
    $input->value(23);
};
ok($@ =~ /^Input 'y' is readonly/);

ok($input->readonly(0));
ok(!$input->readonly);

$input->value(222);
ok(@warn, 0);
ok($f->click->uri->query, "x=1&y=222&z=3");

$input = $f->find_input("z");
ok($input->type, "hidden");
ok($input->readonly);
ok(!$input->disabled);

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
<textarea name="t" type="hidden">
<foo>
</textarea>
<select name=s value=s>
 <option name=y>Foo
 <option name=x value=bar type=x>Bar
</form>
EOT

ok($f->value("t"), "\n<foo>\n");
ok($f->value("s"), "Foo");
ok(join(":", $f->find_input("s")->possible_values), "Foo:bar");
ok(join(":", $f->find_input("s")->other_possible_values), "bar");
ok($f->value("s", "bar"), "Foo");
ok($f->value("s"), "bar");
ok(join(":", $f->find_input("s")->other_possible_values), "");


$f = HTML::Form->parse(<<EOT, base => "http://www.example.com", strict => 1);
<form>

<input type=radio name=r0 value=1 disabled>one

<input type=radio name=r1 value=1 disabled>one
<input type=radio name=r1 value=2>two
<input type=radio name=r1 value=3>three

<input type=radio name=r2 value=1>one
<input type=radio name=r2 value=2 disabled>two
<input type=radio name=r2 value=3>three

<select name=s0>
 <option disabled>1
</select>

<select name=s1>
 <option disabled>1
 <option>2
 <option>3
</select>

<select name=s2>
 <option>1
 <option disabled>2
 <option>3
</select>

<select name=s3 disabled>
 <option>1
 <option disabled>2
 <option>3
</select>

<select name=m0 multiple>
 <option disabled>1
</select>

<select name=m1 multiple="">
 <option disabled>1
 <option>2
 <option>3
</select>

<select name=m2 multiple>
 <option>1
 <option disabled>2
 <option>3
</select>

<select name=m3 disabled multiple>
 <option>1
 <option disabled>2
 <option>3
</select>

</form>

EOT
#print $f->dump;
ok($f->find_input("r0")->disabled);
ok(!eval {$f->value("r0", 1);});
ok($@ && $@ =~ /^The value '1' has been disabled for field 'r0'/);
ok($f->find_input("r0")->disabled(0));
ok(!$f->find_input("r0")->disabled);
ok($f->value("r0", 1), undef);
ok($f->value("r0"), 1);

ok(!$f->find_input("r1")->disabled);
ok($f->value("r1", 2), undef);
ok($f->value("r1"), 2);
ok(!eval {$f->value("r1", 1);});
ok($@ && $@ =~ /^The value '1' has been disabled for field 'r1'/);

ok($f->value("r2", 1), undef);
ok(!eval {$f->value("r2", 2);});
ok($@ && $@ =~ /^The value '2' has been disabled for field 'r2'/);
ok(!eval {$f->value("r2", "two");});
ok($@ && $@ =~ /^The value 'two' has been disabled for field 'r2'/);
ok(!$f->find_input("r2")->disabled(1));
ok(!eval {$f->value("r2", 1);});
ok($@ && $@ =~ /^The value '1' has been disabled for field 'r2'/);
ok($f->find_input("r2")->disabled(0));
ok(!$f->find_input("r2")->disabled);
ok($f->value("r2", 2), 1);

ok($f->find_input("s0")->disabled);
ok(!$f->find_input("s1")->disabled);
ok(!$f->find_input("s2")->disabled);
ok($f->find_input("s3")->disabled);

ok(!eval {$f->value("s1", 1);});
ok($@ && $@ =~ /^The value '1' has been disabled for field 's1'/);

ok($f->find_input("m0")->disabled);
ok($f->find_input("m1", undef, 1)->disabled);
ok(!$f->find_input("m1", undef, 2)->disabled);
ok(!$f->find_input("m1", undef, 3)->disabled);

ok(!$f->find_input("m2", undef, 1)->disabled);
ok($f->find_input("m2", undef, 2)->disabled);
ok(!$f->find_input("m2", undef, 3)->disabled);

ok($f->find_input("m3", undef, 1)->disabled);
ok($f->find_input("m3", undef, 2)->disabled);
ok($f->find_input("m3", undef, 3)->disabled);

$f->find_input("m3", undef, 2)->disabled(0);
ok(!$f->find_input("m3", undef, 2)->disabled);
ok($f->find_input("m3", undef, 2)->value(2), undef);
ok($f->find_input("m3", undef, 2)->value(undef), 2);

$f->find_input("m3", undef, 2)->disabled(1);
ok($f->find_input("m3", undef, 2)->disabled);
ok(eval{$f->find_input("m3", undef, 2)->value(2)}, undef);
ok($@ && $@ =~ /^The value '2' has been disabled/);
ok(eval{$f->find_input("m3", undef, 2)->value(undef)}, undef);
ok($@ && $@ =~ /^The 'm3' field can't be unchecked/);

# multiple select with the same name [RT#18993]
$f = HTML::Form->parse(<<EOT, "http://localhost/");
<form action="target.html" method="get">
<select name="bug">
<option selected value=hi>hi
<option value=mom>mom
</select>
<select name="bug">
<option value=hi>hi
<option selected value=mom>mom
</select>
<select name="nobug">
<option value=hi>hi
<option selected value=mom>mom
</select>
EOT
ok(join("|", $f->form), "bug|hi|bug|mom|nobug|mom");

# Try a disabled radiobutton:
$f = HTML::Form->parse(<<EOT, "http://localhost/");
<form>
 <input disabled checked type=radio name=f value=a>
 <input type=hidden name=f value=b>
</form>

EOT

ok($f->click->as_string, <<'EOT');
GET http://localhost/?f=b

EOT

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<!-- from http://www.blooberry.com/indexdot/html/tagpages/k/keygen.htm -->
<form  METHOD="post" ACTION="http://example.com/secure/keygen/test.cgi" ENCTYPE="application/x-www-form-urlencoded">
   <keygen NAME="randomkey" CHALLENGE="1234567890">
   <input TYPE="text" NAME="Field1" VALUE="Default Text">
</form>
EOT

ok($f->find_input("randomkey"));
ok($f->find_input("randomkey")->challenge, "1234567890");
ok($f->find_input("randomkey")->keytype, "rsa");
ok($f->click->as_string, <<EOT);
POST http://example.com/secure/keygen/test.cgi
Content-Length: 19
Content-Type: application/x-www-form-urlencoded

Field1=Default+Text
EOT

$f->value(randomkey => "foo");
ok($f->click->as_string, <<EOT);
POST http://example.com/secure/keygen/test.cgi
Content-Length: 33
Content-Type: application/x-www-form-urlencoded

randomkey=foo&Field1=Default+Text
EOT

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form  ACTION="http://example.com/">
   <select name=s>
     <option>1
     <option>2
   <input name=t>
</form>
EOT

ok($f);
ok($f->find_input("t"));


@f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form  ACTION="http://example.com/">
   <select name=s>
     <option>1
     <option>2
</form>
<form  ACTION="http://example.com/">
     <input name=t>
</form>
EOT

ok(@f, 2);
ok($f[0]->find_input("s"));
ok($f[1]->find_input("t"));

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form  ACTION="http://example.com/">
  <fieldset>
    <legend>Radio Buttons with Labels</legend>
    <label>
      <input type=radio name=r0 value=0 />zero
    </label>
    <label>one
      <input type=radio name=r1 value=1>
    </label>
    <label for="r2">two</label>
    <input type=radio name=r2 id=r2 value=2>
    <label>
      <span>nested</span>
      <input type=radio name=r3 value=3>
    </label>
    <label>
      before
      and <input type=radio name=r4 value=4>
      after
    </label>
  </fieldset>
</form>
EOT

ok(join(":", $f->find_input("r0")->value_names), "zero");
ok(join(":", $f->find_input("r1")->value_names), "one");
ok(join(":", $f->find_input("r2")->value_names), "two");
ok(join(":", $f->find_input("r3")->value_names), "nested");
ok(join(":", $f->find_input("r4")->value_names), "before and after");

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
  <table>
    <TR>
      <TD align="left" colspan="2">
	&nbsp;&nbsp;&nbsp;&nbsp;Keep me informed on the progress of this election
	<INPUT type="checkbox" id="keep_informed" name="keep_informed" value="yes" checked>
      </TD>
    </TR>
    <TR>
      <TD align=left colspan=2>
	<BR><B>The place you are registered to vote:</B>
      </TD>
    </TR>
    <TR>
      <TD valign="middle" height="2" align="right">
	<A name="Note1back">County or Parish</A>
      </TD>
      <TD align="left">
	<INPUT type="text" id="reg_county" size="40" name="reg_county" value="">
      </TD>
      <TD align="left" width="10">
	<A href="#Note2" class="c2" tabindex="-1">Note&nbsp;2</A>
      </TD>
    </TR>
  </table>
</form>
EOT
ok(join(":", $f->find_input("keep_informed")->value_names), "off:");

$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form action="test" method="post">
<select name="test">
<option value="1">One</option>
<option value="2">Two</option>
<option disabled="disabled" value="3">Three</option>
</select>
<input type="submit" name="submit" value="Go">
</form>
</body>
</html>
EOT
ok(join(":", $f->find_input("test")->possible_values), "1:2");
ok(join(":", $f->find_input("test")->other_possible_values), "2");

@warn = ();
$f = HTML::Form->parse(<<EOT, "http://www.example.com");
<form>
<select id="myselect">
<option>one</option>
<option>two</option>
<option>three</option>
</select>
</form>
EOT
ok(@warn, 0);
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)