#!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/");
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/");
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/");
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/");
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("
"); $f = HTML::Form->parse($response); ok($f->click->as_string, <<"EOT"); GET http://www.example.com?x=42 EOT $f = HTML::Form->parse(< I like it! 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 $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 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(< one one two three one two three 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 ok($f->find_input("randomkey")); ok($f->find_input("randomkey")->challenge, "1234567890"); ok($f->find_input("randomkey")->keytype, "rsa"); ok($f->click->as_string, <value(randomkey => "foo"); ok($f->click->as_string, <parse(< EOT ok($f); ok($f->find_input("t")); @f = HTML::Form->parse(< EOT ok(@f, 2); ok($f[0]->find_input("s")); ok($f[1]->find_input("t")); $f = HTML::Form->parse(<
Radio Buttons with Labels
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");