1#!/usr/bin/perl -T 2 3# This script tests compatibility with HTML::Form's interface. These tests 4# are plagiarised from that module's tests (22/Sep/7), except for a few at 5# the bottom. 6 7use strict; use warnings; use lib 't'; 8 9use Test::More tests 10 => 116 # form.t 11 + 24 # form_param.t 12 + 2 # misc 13 + 3 # <button> 14 + 4; # bugs 15 16BEGIN{ use_ok 'HTML::DOM' }; 17 18# Since HTML::Form's click method is the one to call make_request, whereas 19# with HTML::DOM, it just triggers the event and it is up to an event 20# handler to call make_request, I'm putting a handler here that (sort of) 21# imitates HTML::Form's behaviour, for the sake of the tests. 22 23{ my $req; 24 sub new_doc { 25 0&&$req; # work around perl 5.8 bug 26 my $doc = new HTML::DOM url => shift; 27 $doc->default_event_handler(sub{ 28 my $target = shift->target; 29 $req = ($target->tag eq 'form' ? $target : 30 $target->form)->make_request; 31 }); 32 $doc 33 } 34 sub click { 35 shift->click; 36 return $req; 37 } 38} 39 40 41# ----------- from libwww-5.806/t/html/form.t ------------- # 42my @warn; 43$SIG{__WARN__} = sub { push(@warn, $_[0]) }; 44 45(my $doc = new_doc "http://localhost/")->write(<<'EOT', ); 46<form action="abc" name="foo"> 47<input name="name"> 48</form> 49<form></form> 50EOT 51$doc->close; 52 53my $f = ($doc->forms)[0]; 54is($f->value("name"), ""); 55 56my $req = $f->main::click; 57is($req->method, "GET"); 58is($req->uri, "http://localhost/abc?name="); 59 60$f->value(name => "Gisle Aas"); 61$req = $f->main::click; 62is($req->method, "GET"); 63is($req->uri, "http://localhost/abc?name=Gisle+Aas"); 64 65is($f->attr("name"), "foo"); 66is($f->attr("method"), undef); 67 68$f = ($doc->forms)[1]; 69is($f->method, "get"); 70is($f->action, "http://localhost/"); 71is($f->enctype, "application/x-www-form-urlencoded"); 72 73# try some more advanced inputs 74$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 75<form method=post> 76 <input name=i type="image" src="foo.gif"> 77 <input name=c type="checkbox" checked> 78 <input name=r type="radio" value="a"> 79 <input name=r type="radio" value="b" checked> 80 <input name=t type="text"> 81 <input name=p type="PASSWORD"> 82 <input name=h type="hidden" value=xyzzy> 83 <input name=s type="submit" value="Doit!"> 84 <input name=r type="reset"> 85 <input name=b type="button"> 86 <input name=f type="file" value="foo.txt"> 87 <input name=x type="xyzzy"> 88 89 <textarea name=a> 90abc 91 </textarea> 92 93 <select name=s> 94 <option>Foo 95 <option value="bar" selected>Bar 96 </select> 97 98 <select name=m multiple> 99 <option selected value="a">Foo 100 <option selected value="b">Bar 101 </select> 102</form> 103EOT 104 105 106#print $f->dump; 107#print $f->click->as_string; 108 109my $t = <<'EOT'; 110POST http://localhost/ 111Content-Length: 76 112Content-Type: application/x-www-form-urlencoded; charset="utf-8" 113 114i.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 115EOT 116($t = quotemeta $t) =~ s/\\%0A/(?:%0D)?%0A/g; 117$t =~ s/76/(?:76|82)/; 118like($f->main::click->as_string, qr/^$t\z/); 119 120 121$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 122<form> 123 <input type=submit value="Upload it!" name=n disabled> 124 <input type=image alt="Foo"> 125 <input type=text name=t value="1"> 126</form> 127EOT 128 129#$f->dump; 130is($f->main::click->as_string, <<'EOT'); 131GET http://localhost/?x=1&y=1&t=1 132 133EOT 134 135# test file upload 136$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 137<form method=post enctype="MULTIPART/FORM-DATA"> 138 <input name=f type=file value=> 139 <input type=submit value="Upload it!"> 140</form> 141EOT 142 143#print $f->dump; 144#print $f->click->as_string; 145 146is($f->main::click->as_string, <<'EOT'); 147POST http://localhost/ 148Content-Length: 0 149Content-Type: multipart/form-data; boundary=none 150 151EOT 152 153my $filename = sprintf "foo-%08d.txt", $$; 154die if -e $filename; 155 156open(FILE, ">$filename") || die; 157binmode(FILE); 158print FILE "This is some text\n"; 159close(FILE) || die; 160 161$f->value(f => $filename); 162 163#print $f->click->as_string; 164 165is($f->main::click->as_string, <<"EOT"); 166POST http://localhost/ 167Content-Length: 139 168Content-Type: multipart/form-data; boundary=xYzZY 169 170--xYzZY\r 171Content-Disposition: form-data; name="f"; filename="$filename"\r 172Content-Type: text/plain\r 173\r 174This is some text 175\r 176--xYzZY--\r 177EOT 178 179unlink($filename) || warn "Can't unlink '$filename': $!"; 180 181is(@warn, 0); 182 183 184$doc = new_doc "http://www.example.com"; 185$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 186<form> 187 <input type=checkbox name=x> I like it! 188</form> 189EOT 190 191 192SKIP:{ skip 'not supported', 1; # and probably won't ever be 193$f->find_input("x")->check; 194 195is($f->main::click->as_string, <<"EOT"); 196GET http://www.example.com?x=on 197 198EOT 199} 200 201 202SKIP: { skip 'not yet implemented', 3; 203$f->value("x", "off"); 204ok($f->main::click->as_string, <<"EOT"); 205GET http://www.example.com 206 207EOT 208 209$f->value("x", "I like it!"); 210ok($f->main::click->as_string, <<"EOT"); 211GET http://www.example.com?x=on 212 213EOT 214 215$f->value("x", "I LIKE IT!"); 216ok($f->main::click->as_string, <<"EOT"); 217GET http://www.example.com?x=on 218 219EOT 220} # SKIP 221 222 223 224$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 225<form> 226<select name=x> 227 <option value=1>one 228 <option value=2>two 229 <option>3 230</select> 231<select name=y multiple> 232 <option value=1> 233</select> 234</form> 235EOT 236 237$f->value("x", "one"); 238 239is($f->main::click->as_string, <<"EOT"); 240GET http://www.example.com?x=1 241 242EOT 243 244SKIP: { skip 'not yet implemented', 2; 245$f->value("x", "TWO"); 246ok($f->main::click->as_string, <<"EOT"); 247GET http://www.example.com?x=2 248 249EOT 250 251ok(join(":", $f->find_input("x")->value_names), "one:two:3"); 252} # SKIP 253 254is(join(":", map $_->name, $f->find_input(undef, "option")), "x:y"); 255 256$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 257<form> 258<input name=x value=1 disabled> 259<input name=y value=2 READONLY type=TEXT> 260<input name=z value=3 type=hidden> 261</form> 262EOT 263 264is($f->value("x"), 1); 265is($f->value("y"), 2); 266is($f->value("z"), 3); 267is($f->main::click->uri->query, "y=2&z=3"); 268 269my $input = $f->find_input("x"); 270is($input->type, "text"); 271SKIP: { skip 'not supported', 1; 272ok(!$input->readonly); 273} 274ok($input->disabled); 275ok($input->disabled(0)); 276ok(!$input->disabled); 277is($f->main::click->uri->query, "x=1&y=2&z=3"); 278 279$input = $f->find_input("y"); 280is($input->type, "text"); 281SKIP: { skip 'not supported', 1; 282ok($input->readonly); 283} 284ok(!$input->disabled); 285 286$input->value(22); 287is($f->main::click->uri->query, "x=1&y=22&z=3"); 288SKIP:{ skip 'not yet implemented', 2; # if ever? 289ok(@warn, 1); 290ok($warn[0] =~ /^Input 'y' is readonly/); 291} 292@warn = (); 293 294SKIP:{ skip 'not supported', 2; 295ok($input->readonly(0)); 296ok(!$input->readonly); 297} 298 299$input->value(222); 300SKIP: { skip 'not yet implemented', 1; 301ok(@warn, 0); 302print @warn; 303} 304is($f->main::click->uri->query, "x=1&y=222&z=3"); 305 306$input = $f->find_input("z"); 307is($input->type, "hidden"); 308SKIP: { skip 'not supported', 1; 309ok($input->readonly); 310} 311ok(!$input->disabled); 312 313$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 314<form> 315<textarea name="t" type="hidden"> 316<foo> 317</textarea> 318<select name=s value=s> 319 <option name=y>Foo 320 <option name=x value=bar type=x>Bar 321</form> 322EOT 323 324is($f->value("t"), "\n<foo>\n"); 325SKIP: { skip 'doesn\'t work yet', 2; is($f->value("s"), "Foo"); 326is(join(":", $f->find_input("s")->possible_values), "Foo:bar"); } # ~~~ 327SKIP: { skip 'not supported', 1; 328ok(join(":", $f->find_input("s")->other_possible_values), "bar"); 329} 330SKIP: { skip "doesn't work yet",2; is($f->value("s", "bar"), "Foo"); 331is($f->value("s"), "bar");} # ~~~ 332SKIP: { skip 'not supported', 1; 333ok(join(":", $f->find_input("s")->other_possible_values), ""); 334} 335 336 337$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 338<form> 339 340<input type=radio name=r0 value=1 disabled>one 341 342<input type=radio name=r1 value=1 disabled>one 343<input type=radio name=r1 value=2>two 344<input type=radio name=r1 value=3>three 345 346<input type=radio name=r2 value=1>one 347<input type=radio name=r2 value=2 disabled>two 348<input type=radio name=r2 value=3>three 349 350<select name=s0> 351 <option disabled>1 352</select> 353 354<select name=s1> 355 <option disabled>1 356 <option>2 357 <option>3 358</select> 359 360<select name=s2> 361 <option>1 362 <option disabled>2 363 <option>3 364</select> 365 366<select name=s3 disabled> 367 <option>1 368 <option disabled>2 369 <option>3 370</select> 371 372<select name=m0 multiple> 373 <option disabled>1 374</select> 375 376<select name=m1 multiple=""> 377 <option disabled>1 378 <option>2 379 <option>3 380</select> 381 382<select name=m2 multiple> 383 <option>1 384 <option disabled>2 385 <option>3 386</select> 387 388<select name=m3 disabled multiple> 389 <option>1 390 <option disabled>2 391 <option>3 392</select> 393 394</form> 395 396EOT 397#print $f->dump; 398ok($f->find_input("r0")->disabled); 399ok(!eval {$f->value("r0", 1);}); 400ok($@ && $@ =~ /^The value '1' has been disabled for field 'r0'/); 401SKIP: { skip 'not supported', 4; 402ok($f->find_input("r0")->disabled(0)); 403ok(!$f->find_input("r0")->disabled); # test 59 404is($f->value("r0", 1), undef); 405is($f->value("r0"), 1); 406} 407 408ok(!$f->find_input("r1")->disabled); 409is($f->value("r1", 2), undef); 410is($f->value("r1"), 2); 411ok(!eval {$f->value("r1", 1);}); 412ok($@ && $@ =~ /^The value '1' has been disabled for field 'r1'/); 413 414is($f->value("r2", 1), undef); 415ok(!eval {$f->value("r2", 2);}); 416ok($@ && $@ =~ /^The value '2' has been disabled for field 'r2'/); 417SKIP: { skip 'not yet implemented', 2; 418ok(!eval {$f->value("r2", "two");}); # test 70 419ok($@ && $@ =~ /^The value 'two' has been disabled for field 'r2'/); 420} 421SKIP : { skip 'not supported', 4; 422ok(!$f->find_input("r2")->disabled(1)); 423ok(!eval {$f->value("r2", 1);}); 424ok($@ && $@ =~ /^The value '1' has been disabled for field 'r2'/); 425ok($f->find_input("r2")->disabled(0)); 426} 427ok(!$f->find_input("r2")->disabled); 428SKIP : { skip 'not supported', 1; 429is($f->value("r2", 2), 1); 430} 431 432ok($f->find_input("s0")->disabled); # test 78 433ok(!$f->find_input("s1")->disabled); 434ok(!$f->find_input("s2")->disabled); 435ok($f->find_input("s3")->disabled); 436 437SKIP: { skip "doesn't work yet", 2; 438ok(!eval {$f->value("s1", 1);}); 439ok($@ && $@ =~ /^The value '1' has been disabled for field 's1'/); 440} 441 442ok($f->find_input("m0")->disabled); 443SKIP: { skip "doesn't work yet", 17; 444ok($f->find_input("m1", undef, 1)->disabled); 445ok(!$f->find_input("m1", undef, 2)->disabled); 446ok(!$f->find_input("m1", undef, 3)->disabled); 447 448ok(!$f->find_input("m2", undef, 1)->disabled); 449ok($f->find_input("m2", undef, 2)->disabled); 450ok(!$f->find_input("m2", undef, 3)->disabled); 451 452ok($f->find_input("m3", undef, 1)->disabled); 453ok($f->find_input("m3", undef, 2)->disabled); 454ok($f->find_input("m3", undef, 3)->disabled); 455 456$f->find_input("m3", undef, 2)->disabled(0); 457ok(!$f->find_input("m3", undef, 2)->disabled); 458is($f->find_input("m3", undef, 2)->value(2), undef); 459is($f->find_input("m3", undef, 2)->value(undef), 2); 460 461$f->find_input("m3", undef, 2)->disabled(1); 462ok($f->find_input("m3", undef, 2)->disabled); 463is(eval{$f->find_input("m3", undef, 2)->value(2)}, undef); 464ok($@ && $@ =~ /^The value '2' has been disabled/); 465is(eval{$f->find_input("m3", undef, 2)->value(undef)}, undef); 466ok($@ && $@ =~ /^The 'm3' field can't be unchecked/); 467} 468 469SKIP:{ skip 'not supported', 5; 470$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 471<!-- from http://www.blooberry.com/indexdot/html/tagpages/k/keygen.htm --> 472<form METHOD="post" ACTION="http://example.com/secure/keygen/test.cgi" ENCTYPE="application/x-www-form-urlencoded"> 473 <keygen NAME="randomkey" CHALLENGE="1234567890"> 474 <input TYPE="text" NAME="Field1" VALUE="Default Text"> 475</form> 476EOT 477 478ok($f->find_input("randomkey")); 479ok($f->find_input("randomkey")->challenge, "1234567890"); 480ok($f->find_input("randomkey")->keytype, "rsa"); 481ok($f->main::click->as_string, <<EOT); 482POST http://example.com/secure/keygen/test.cgi 483Content-Length: 19 484Content-Type: application/x-www-form-urlencoded; charset=utf-8 485 486Field1=Default+Text 487EOT 488 489$f->value(randomkey => "foo"); 490ok($f->main::click->as_string, <<EOT); 491POST http://example.com/secure/keygen/test.cgi 492Content-Length: 33 493Content-Type: application/x-www-form-urlencoded; charset=utf-8 494 495randomkey=foo&Field1=Default+Text 496EOT 497} # SKIP 498 499$doc = new_doc "http://www.example.com"; 500$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 501<form ACTION="http://example.com/"> 502 <select name=s> 503 <option>1 504 <option>2 505 <input name=t> 506</form> 507EOT 508 509ok($f); 510ok($f->find_input("t")); 511 512 513$doc->write(<<'EOT'); $doc->close; my @f = $doc->forms; 514<form ACTION="http://example.com/"> 515 <select name=s> 516 <option>1 517 <option>2 518</form> 519<form ACTION="http://example.com/"> 520 <input name=t> 521</form> 522EOT 523 524is(@f, 2); 525ok($f[0]->find_input("s")); 526ok($f[1]->find_input("t")); 527 528SKIP: { skip 'not supported (?)', 5; 529$doc->write(<<'EOT'); $doc->close; $f = ($doc->forms)[0]; 530<form ACTION="http://example.com/"> 531 <fieldset> 532 <legend>Radio Buttons with Labels</legend> 533 <label> 534 <input type=radio name=r0 value=0 />zero 535 </label> 536 <label>one 537 <input type=radio name=r1 value=1> 538 </label> 539 <label for="r2">two</label> 540 <input type=radio name=r2 id=r2 value=2> 541 <label> 542 <span>nested</span> 543 <input type=radio name=r3 value=3> 544 </label> 545 <label> 546 before 547 and <input type=radio name=r4 value=4> 548 after 549 </label> 550 </fieldset> 551</form> 552EOT 553 554is(join(":", $f->find_input("r0")->value_names), "zero"); 555is(join(":", $f->find_input("r1")->value_names), "one"); 556is(join(":", $f->find_input("r2")->value_names), "two"); 557is(join(":", $f->find_input("r3")->value_names), "nested"); 558is(join(":", $f->find_input("r4")->value_names), "before and after"); 559} 560 561 562# ----------- from libwww-5.806/t/html/form-param.t ------------- # 563# Tests 117 onwards 564 565($doc = new_doc "http://example.com") 566 ->write(<<'EOT', ); my $form = ($doc->forms)[0]; 567<form> 568<input type="hidden" name="hidden_1"> 569 570<input type="checkbox" name="checkbox_1" value="c1_v1" CHECKED> 571<input type="checkbox" name="checkbox_1" value="c1_v2" CHECKED> 572<input type="checkbox" name="checkbox_2" value="c2_v1" CHECKED> 573 574<select name="multi_select_field" multiple="1"> 575 <option> 1 576 <option> 2 577 <option> 3 578</select> 579</form> 580EOT 581 582# list names 583is($form->param, 4); 584is(j($form->param), "hidden_1:checkbox_1:checkbox_2:multi_select_field"); 585 586# get 587is($form->param('hidden_1'), ''); 588is($form->param('checkbox_1'), 'c1_v1'); 589is(j($form->param('checkbox_1')), 'c1_v1:c1_v2'); 590is($form->param('checkbox_2'), 'c2_v1'); 591is(j($form->param('checkbox_2')), 'c2_v1'); 592ok(!defined($form->param('multi_select_field'))); 593is(j($form->param('multi_select_field')), ''); 594ok(!defined($form->param('unknown'))); 595is(j($form->param('unknown')), ''); 596ok(!@warn, 'no warnings'); 597 598# set 599$form->param('hidden_1', 'x'); 600SKIP:{ skip 'not yet implemented', 1; 601ok(@warn && $warn[0] =~ /^Input 'hidden_1' is readonly/); 602} 603@warn = (); 604is(j($form->param('hidden_1')), 'x'); 605 606eval { 607 $form->param('checkbox_1', 'foo'); 608}; 609ok($@); 610is(j($form->param('checkbox_1')), 'c1_v1:c1_v2'); 611 612$form->param('checkbox_1', 'c1_v2'); 613is(j($form->param('checkbox_1')), 'c1_v2'); 614$form->param('checkbox_1', 'c1_v2'); 615is(j($form->param('checkbox_1')), 'c1_v2'); 616$form->param('checkbox_1', []); 617is(j($form->param('checkbox_1')), ''); 618$form->param('checkbox_1', ['c1_v2', 'c1_v1']); 619is(j($form->param('checkbox_1')), 'c1_v1:c1_v2'); 620$form->param('checkbox_1', []); 621is(j($form->param('checkbox_1')), ''); 622$form->param('checkbox_1', 'c1_v2', 'c1_v1'); 623is(j($form->param('checkbox_1')), 'c1_v1:c1_v2'); 624 625SKIP: { skip "doesn't work yet", 1; 626$form->param('multi_select_field', 3, 2); 627is(j($form->param('multi_select_field')), "2:3"); 628} 629 630print "# Done\n"; 631ok(!@warn); 632 633sub j { 634 join(":", @_); 635} 636 637# -------- Miscellaneous Tests That Were Not Filched from LWP -------- # 638 639$doc->open; $doc->write( 640 '<form action="file:///dwile"><input name=plew value=glor> 641 <input name=frat value=flin></form>' 642); 643is +($doc->forms)[0]->make_request->uri, 644 'file:///dwile?plew=glor&frat=flin', 645 'make_request with the file protocol'; 646$doc->open; $doc->write( 647 '<form action="data:text/html,squext"><input name=plew value=glor> 648 <input name=frat value=flin></form>' 649); 650is +($doc->forms)[0]->make_request->uri, 651 'data:text/html,squext', 652 'make_request with GET method and data: URL'; 653 654# -------- <button> elements ---------- # 655 656$doc->close; 657$doc->write("<form><button name=b value=v><button name=b value=w> 658 <button name=btnAccept></button>(no value) 659 <button type=reset name=c value=d> 660 <button type=button name=e value=f> 661 </form>"); 662is $doc->getElementsByTagName('button')->[1]->main'click->as_string, 663 "GET http://example.com?b=w\n\n", '<button> elements'; 664is +($doc->forms)[0]->main::click->as_string, 665 "GET http://example.com?b=v\n\n", 666 'form->click supports <button>s'; 667is $doc->getElementsByTagName('button')->[2]->main'click->as_string, 668 "GET http://example.com?btnAccept=\n\n", '<button> element with no val'; 669 670# -------- Bugs related to HTML::DOM’s HTML::Form imitation ---------- # 671{ 672 673my $doc = new HTML::DOM; 674$doc->write('<title>What’s up, Doc?</title> 675 <form><select name=Bunny><!-- no options --></select></form>'); 676$doc->close; 677is eval { $doc->forms->[0]->{Bunny}->options->name } || diag($@), 'Bunny', 678 'select->options->name no longer dies when there are no options'; 679 680$doc->write( 681 '<form><input name=c type=checkbox value=12345 checked></form>' 682); 683my $f = $doc->forms->[0]; 684$f->value(c => undef); 685ok ! $f->{c}->checked, 'form->value(field, undef) unchecks a checkbox'; 686 687local $SIG{__WARN__}; 688$f->innerHTML( 689 '<input name=c type=radio value=a><input name=c type=radio value=b>' 690); 691my $radioset = $f->find_input('c'); 692$radioset->value('a'); 693ok $f->{c}[0]->checked && !$f->{c}[1]->checked, 694 '->value(x) on radio nodelist works if nothing is checked yet'; 695$radioset->value('b'); 696ok !$f->{c}[0]->checked && $f->{c}[1]->checked, 697 '->value(x) on radio nodelist works if something is checked already'; 698 699} 700 701