#!perl -w use strict; use Test qw(plan ok); plan tests => 122; 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', "http://localhost/"); <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=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: 76 Content-Type: application/x-www-form-urlencoded i.x=1&i.y=1&c=on&r=b&t=&p=&h=xyzzy&f=foo.txt&x=&a=%0Aabc%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=> <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"); ok(@warn, 1); ok($warn[0] =~ /^Input 'y' is readonly/); @warn = (); ok($input->readonly(0)); ok(!$input->readonly); $input->value(222); ok(@warn, 0); print @warn; 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, "http://www.example.com"); <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/); $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");