HTML-Form-6.12/ 0000775 0001750 0001750 00000000000 14704505176 011546 5 ustar olaf olaf HTML-Form-6.12/t/ 0000775 0001750 0001750 00000000000 14704505176 012011 5 ustar olaf olaf HTML-Form-6.12/t/form-selector.t 0000644 0001750 0001750 00000002031 14704505176 014751 0 ustar olaf olaf #!perl
use strict;
use warnings;
use Test::More tests => 12;
use HTML::Form;
my $form
= HTML::Form->parse( <<"EOT", base => "http://example.com", strict => 1 );
EOT
#$form->dump;
is( $form->value("n1"), 1 );
is( $form->value("^n1"), 1 );
is( $form->value("#id1"), 1 );
is( $form->value(".A"), 1 );
is( $form->value("#id2"), 2 );
is( $form->value(".B"), 3 );
is( j( map $_->value, $form->find_input(".A") ), "1:2" );
$form->find_input("#id2")->name("n2");
$form->value( "#id2", 22 );
is( $form->click->uri->query, "n1=1&n2=22" );
# try some odd names
is( $form->find_input("##foo")->name, "#bar" );
is( $form->find_input("#bar"), undef );
is( $form->find_input("^#bar")->class, ".D" );
is( $form->find_input("..D")->id, "#foo" );
sub j {
join( ":", @_ );
}
HTML-Form-6.12/t/form-multi-select.t 0000644 0001750 0001750 00000005221 14704505176 015544 0 ustar olaf olaf #!/usr/bin/perl
# Test for case when multiple forms are on a page with same-named fields.
use strict;
use Test::More tests => 2;
use HTML::Form;
{
my $test
= "the settings of a previous form should not interfere with a latter form (control test with one form)";
my @forms = HTML::Form->parse( FakeResponse::One->new );
my $cat_form = $forms[0];
my @vals = $cat_form->param('age');
is_deeply( \@vals, [''], $test );
}
{
my $test
= "the settings of a previous form should not interfere with a latter form (test with two forms)";
my @forms = HTML::Form->parse( FakeResponse::TwoForms->new );
my $cat_form = $forms[1];
my @vals = $cat_form->param('age');
is_deeply( \@vals, [''], $test );
}
####
package FakeResponse::One;
sub new {
bless {}, shift;
}
sub base {
return "http://foo.com";
}
sub content_charset {
return "iso-8859-1";
}
sub decoded_content {
my $html = qq{
};
return \$html;
}
#####
package FakeResponse::TwoForms;
sub new {
bless {}, shift;
}
sub base {
return "http://foo.com";
}
sub decoded_content {
my $html = qq{
};
return \$html;
}
HTML-Form-6.12/t/form-parse.t 0000644 0001750 0001750 00000000475 14704505176 014255 0 ustar olaf olaf #!perl
use strict;
use warnings;
use Test::More;
use HTML::Form ();
use Test::Warnings qw(warning);
$^W = 1;
like(
warning {
HTML::Form->parse( q{}, base => 'http://localhost/', foo => 1 )
},
qr/^Unrecognized option foo in HTML::Form/,
'caught invalid option to parse()',
);
done_testing;
HTML-Form-6.12/t/form-param.t 0000644 0001750 0001750 00000005611 14704505176 014240 0 ustar olaf olaf #!perl
use strict;
use warnings;
use HTML::Form ();
use Test::More;
my $form
= HTML::Form->parse( <<"EOT", base => "http://example.com", strict => 1 );
EOT
is( $form->param, 4, '4 params' );
is(
j( $form->param ), "hidden_1:checkbox_1:checkbox_2:multi_select_field",
'param names'
);
is(
$form->find_input('checkbox_1')->type, 'checkbox',
'checkbox_1 is a checkbox'
);
is( $form->param('hidden_1'), '', 'hidden1 empty' );
is( $form->param('checkbox_1'), 'c1_v1', 'checkbox_1' );
is(
j( $form->param('checkbox_1') ), 'c1_v1:c1_v2',
'all checkbox_1 values'
);
is( $form->param('checkbox_2'), 'c2_v1', 'checkbox_2 value' );
is( j( $form->param('checkbox_2') ), 'c2_v1', 'all checkbox_2 values' );
is(
$form->find_input('checkbox_2')->type, 'checkbox',
'checkbox_2 is a checkbox'
);
ok(
!defined( $form->param('multi_select_field') ),
'no multi-select field value'
);
is(
j( $form->param('multi_select_field') ), '',
'no multi_select_field values'
);
subtest 'unknown' => sub {
ok( !defined( $form->param('unknown') ), 'single unknown param' );
is( j( $form->param('unknown') ), '', 'multiple unknown params' );
};
subtest 'exceptions' => sub {
eval { $form->param( 'hidden_1', 'x' ); };
like( $@, qr/readonly/, 'error on setting readonly field' );
is( j( $form->param('hidden_1') ), '', 'hidden_1 empty' );
eval { $form->param( 'checkbox_1', 'foo' ); };
like( $@, qr/Illegal value/, 'error on setting illegal value' );
is(
j( $form->param('checkbox_1') ), 'c1_v1:c1_v2',
'checkbox_1 was not reset after illegal value'
);
};
$form->param( 'checkbox_1', 'c1_v2' );
is(
j( $form->param('checkbox_1') ), 'c1_v2',
'checkbox_1 set to single value'
);
is( j( $form->param('checkbox_1') ), 'c1_v2', 'checkbox_1 value reset' );
$form->param( 'checkbox_1', [] );
is( j( $form->param('checkbox_1') ), '', 'checkbox_1 empty' );
$form->param( 'checkbox_1', [ 'c1_v2', 'c1_v1' ] );
is(
j( $form->param('checkbox_1') ), 'c1_v1:c1_v2',
'multiple checkbox_1 values have been set'
);
$form->param( 'checkbox_1', [] );
is( j( $form->param('checkbox_1') ), '', 'checkbox_1 empty again' );
$form->param( 'checkbox_1', 'c1_v2', 'c1_v1' );
is(
j( $form->param('checkbox_1') ), 'c1_v1:c1_v2',
'multiple checkbox_1 values again'
);
$form->param( 'multi_select_field', 3, 2 );
is(
j( $form->param('multi_select_field') ), "2:3",
'multiple multi_select_field values'
);
# This should be replaced. We could just be comparing arrays.
sub j {
join( ":", @_ );
}
done_testing();
HTML-Form-6.12/t/form-unicode.t 0000644 0001750 0001750 00000003621 14704505176 014565 0 ustar olaf olaf #!perl
use strict;
use warnings;
use Test::More tests => 15;
use HTML::Form;
my @warn;
$SIG{__WARN__} = sub { push( @warn, $_[0] ) };
my $f = HTML::Form->parse( <<'EOT', "http://localhost/" );
EOT
is( $f->value("name"), "" );
is( $f->accept_charset, "UNKNOWN" );
my $req = $f->click;
is( $req->uri, "http://localhost/abc?name=&latin=" );
$f->value( name => "\x{0424}" ); # capital cyrillic ef
$f->value( latin => "\xE5" ); # aring
$req = $f->click;
is( $req->method, "GET" );
is( $req->uri, "http://localhost/abc?name=%D0%A4&latin=%C3%A5" );
$f->method('POST');
$f->enctype('multipart/form-data');
$req = $f->click;
is( $req->uri, "http://localhost/abc" );
is(
$req->content,
"--xYzZY\r\nContent-Disposition: form-data; name=\"name\"\r\n\r\n\xD0\xA4\r\n--xYzZY\r\nContent-Disposition: form-data; name=\"latin\"\r\n\r\n\xC3\xA5\r\n--xYzZY--\r\n"
);
$f->accept_charset('koi8-r');
$req = $f->click;
is( $req->uri, "http://localhost/abc" );
is(
$req->content,
"--xYzZY\r\nContent-Disposition: form-data; name=\"name\"\r\n\r\n\xE6\r\n--xYzZY\r\nContent-Disposition: form-data; name=\"latin\"\r\n\r\n?\r\n--xYzZY--\r\n"
);
$f->method('GET');
$req = $f->click;
is( $req->uri, "http://localhost/abc?name=%E6&latin=%3F" );
$f = HTML::Form->parse( <<'EOT', "http://localhost/" );
EOT
is( $f->accept_charset, 'koi8-r' );
$f->value( name => "\x{0425}" ); # capital cyrillic kha
$req = $f->click;
is( $req->method, "GET" );
is( $req->uri, "http://localhost/abc?name=%E8" );
$f->method('POST');
$f->enctype('multipart/form-data');
$req = $f->click;
is( $req->uri, "http://localhost/abc" );
is(
$req->content,
"--xYzZY\r\nContent-Disposition: form-data; name=\"name\"\r\n\r\n\xE8\r\n--xYzZY--\r\n"
);
HTML-Form-6.12/t/form-label.t 0000644 0001750 0001750 00000001047 14704505176 014216 0 ustar olaf olaf #!perl
use strict;
use warnings;
use Test::More tests => 2;
use HTML::Form;
{
my $form = HTML::Form->parse(
<<"EOT", base => "http://example.com", strict => 1 );
EOT
is( $form->param('tt'), 'test content' );
}
{
my $form = HTML::Form->parse(
<<"EOT", base => "http://example.com", strict => 1 );
EOT
is( $form->param('tt'), 'test content' );
}
HTML-Form-6.12/t/find_input.t 0000644 0001750 0001750 00000001432 14704505176 014333 0 ustar olaf olaf #!/usr/bin/perl
use strict;
use warnings;
use Test::More;
use HTML::Form ();
use Test::Warnings qw(warning);
my $html = ' ';
my $form = HTML::Form->parse( $html, 'http://example.com' );
ok( $form, 'form created' );
ok(
!eval {
$form->find_input( 'submit', 'button', 0 );
1;
},
'index 0'
);
like( $@, qr/Invalid index 0/, 'exception text' );
ok(
!eval {
$form->find_input( 'submit', 'button', 'a' );
1;
},
'index a'
);
like( $@, qr/Invalid index a/, 'exception text' );
{
like(
warning {
my @inputs = $form->find_input( 'submit', 'input', 1 );
},
qr/^find_input called in list context with index specified/,
'warning text'
);
}
done_testing;
HTML-Form-6.12/t/00-report-prereqs.dd 0000644 0001750 0001750 00000005765 14704505176 015544 0 ustar olaf olaf do { my $x = {
'configure' => {
'requires' => {
'ExtUtils::MakeMaker' => '0'
},
'suggests' => {
'JSON::PP' => '2.27300'
}
},
'develop' => {
'recommends' => {
'Dist::Zilla::PluginBundle::Git::VersionManager' => '0.007'
},
'requires' => {
'File::Spec' => '0',
'IO::Handle' => '0',
'IPC::Open3' => '0',
'Pod::Coverage::TrustPod' => '0',
'Pod::Wordlist' => '0',
'Test::EOL' => '0',
'Test::MinimumVersion' => '0',
'Test::Mojibake' => '0',
'Test::More' => '0.94',
'Test::NoTabs' => '0',
'Test::Pod' => '1.41',
'Test::Pod::Coverage' => '1.08',
'Test::Portability::Files' => '0',
'Test::Spelling' => '0.12',
'Test::Version' => '1',
'perl' => '5.006',
'warnings' => '0'
}
},
'runtime' => {
'requires' => {
'Carp' => '0',
'Encode' => '2',
'HTML::TokeParser' => '0',
'HTTP::Request' => '6',
'HTTP::Request::Common' => '6.03',
'Test::More' => '0.96',
'URI' => '1.10',
'parent' => '0',
'perl' => '5.008001',
'strict' => '0'
}
},
'test' => {
'recommends' => {
'CPAN::Meta' => '2.120900'
},
'requires' => {
'ExtUtils::MakeMaker' => '0',
'File::Spec' => '0',
'HTTP::Response' => '0',
'Test::More' => '0.96',
'Test::Warnings' => '0',
'warnings' => '0'
}
}
};
$x;
} HTML-Form-6.12/t/file_upload.t 0000644 0001750 0001750 00000006722 14704505176 014466 0 ustar olaf olaf use strict;
use warnings;
use Test::More;
use HTML::Form;
my ( $form, $input );
sub new_form_and_input {
$form = HTML::Form->new( 'POST', '/', 'multipart/form-data' );
$form->push_input( 'file', { name => 'document' } );
($input) = $form->inputs;
return $form, $input;
}
my $file = 't/file_upload.txt';
my $filename = 'the_uploaded_file.txt';
# Using [$file, $filename] as argument
# $input->value and array refs
( $form, $input ) = new_form_and_input;
$input->value( [ $file, $filename ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
'Upload: using $input->value([$file, $filename])'
);
# $input->file and array refs
( $form, $input ) = new_form_and_input;
$input->file( [ $file, $filename ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
'Upload: using $input->file([$file, $filename])'
);
# $form->value and array refs
( $form, $input ) = new_form_and_input;
$form->value( 'document', [ $file, $filename ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
q/Upload: using $form->value('document', [$file, $filename])/
);
# Using [$file, $filename, Content => 'inline content'] as argument
# $input->value and array refs
( $form, $input ) = new_form_and_input;
$input->value( [ $file, $filename, Content => 'inline content' ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
q/Upload: using $input->value([$file, $filename, Content => '?'])/
);
# $input->file and array refs
( $form, $input ) = new_form_and_input;
$input->file( [ $file, $filename, Content => 'inline content' ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
q/Upload: using $input->file([$file, $filename, Content => '?'])/
);
# $input->file and array refs and undef
( $form, $input ) = new_form_and_input;
$input->file( [ undef, $filename, Content => 'inline content' ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
q/Upload: using $input->file([undef, $filename, Content => '?'])/
);
# $form->value and array refs
( $form, $input ) = new_form_and_input;
$form->value( 'document', [ $file, $filename, Content => 'inline content' ] );
like(
$form->make_request->as_string, qr! filename="$filename" !x,
q/Upload: using $form->value('document', [$file, $filename, Content => '?'])/
);
# Using methods (file, filename, content) directly
# 'file' informed directly
( $form, $input ) = new_form_and_input;
$input->file($file);
like(
$form->make_request->as_string, qr! filename="$file" !x,
"Upload: 'file' informed directly and used as 'filename'"
);
# 'file' and 'filename' informed directly
( $form, $input ) = new_form_and_input;
$input->file($file);
$input->filename($filename);
like(
$form->make_request->as_string, qr! filename="$filename" !x,
"Upload: 'file' and 'filename' informed directly"
);
# 'file', 'filename' and 'content' informed directly
( $form, $input ) = new_form_and_input;
$input->file($file);
$input->filename($filename);
$input->content('inline content');
like(
$form->make_request->as_string, qr! filename="$filename" !x,
"Upload: 'file', 'filename' and 'content' informed directly"
);
# undef, 'filename' and 'content' informed directly
( $form, $input ) = new_form_and_input;
$input->filename($filename);
$input->content('inline content');
like(
$form->make_request->as_string, qr! filename="$filename" !x,
"Upload: undef, 'filename' and 'content' informed directly"
);
done_testing;
HTML-Form-6.12/t/file_upload.txt 0000644 0001750 0001750 00000000031 14704505176 015025 0 ustar olaf olaf First line.
Second line.
HTML-Form-6.12/t/autocomplete.t 0000644 0001750 0001750 00000001420 14704505176 014672 0 ustar olaf olaf #!perl
use strict;
use warnings;
use HTML::Form;
use Test::More;
my $form = HTML::Form->parse( <<'EOT', "http://localhost/" );
EOT
isa_ok( $form, 'HTML::Form' );
{
my $input = $form->find_input('#password-field');
is( $input->autocomplete, 'password', 'autocomplete parsed' );
$input->autocomplete('foo');
is( $input->autocomplete, 'foo', 'autocomplete is settable' );
}
{
my $input = $form->find_input('#login-field');
is( $input->autocomplete, undef, 'autocomplete is undef' );
$input->autocomplete('foo');
is( $input->autocomplete, 'foo', 'autocomplete is settable' );
}
done_testing();
HTML-Form-6.12/t/form-maxlength.t 0000644 0001750 0001750 00000003427 14704505176 015132 0 ustar olaf olaf #!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 12;
use HTML::Form;
my $html = do { local $/ = undef; };
my $form = HTML::Form->parse( $html, 'foo.html' );
isa_ok( $form, 'HTML::Form' );
my $input = $form->find_input('passwd');
isa_ok( $input, 'HTML::Form::TextInput' );
sub set_value {
my $input = shift;
my $value = shift;
my $len = length($value);
my $old = $input->value;
is( $input->value($value), $old, "set value length=$len" );
is( $input->value, $value, "got value length=$len" );
}
{
is( $input->{maxlength}, 8, 'got maxlength: 8' );
set_value( $input, '1234' );
set_value( $input, '1234567890' );
ok( !$input->strict, "not strict by default" );
$form->strict(1);
ok( $input->strict, "input strict change when form strict change" );
set_value( $input, '1234' );
eval { set_value( $input, '1234567890' ); };
like( $@, qr/^Input 'passwd' has maxlength '8' at /, "Exception raised" );
}
__DATA__
remember me
password reminder
Create A New User
HTML-Form-6.12/t/00-report-prereqs.t 0000644 0001750 0001750 00000013601 14704505176 015404 0 ustar olaf olaf #!perl
use strict;
use warnings;
# This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.029
use Test::More tests => 1;
use ExtUtils::MakeMaker;
use File::Spec;
# from $version::LAX
my $lax_version_re =
qr/(?: undef | (?: (?:[0-9]+) (?: \. | (?:\.[0-9]+) (?:_[0-9]+)? )?
|
(?:\.[0-9]+) (?:_[0-9]+)?
) | (?:
v (?:[0-9]+) (?: (?:\.[0-9]+)+ (?:_[0-9]+)? )?
|
(?:[0-9]+)? (?:\.[0-9]+){2,} (?:_[0-9]+)?
)
)/x;
# hide optional CPAN::Meta modules from prereq scanner
# and check if they are available
my $cpan_meta = "CPAN::Meta";
my $cpan_meta_pre = "CPAN::Meta::Prereqs";
my $HAS_CPAN_META = eval "require $cpan_meta; $cpan_meta->VERSION('2.120900')" && eval "require $cpan_meta_pre"; ## no critic
# Verify requirements?
my $DO_VERIFY_PREREQS = 1;
sub _max {
my $max = shift;
$max = ( $_ > $max ) ? $_ : $max for @_;
return $max;
}
sub _merge_prereqs {
my ($collector, $prereqs) = @_;
# CPAN::Meta::Prereqs object
if (ref $collector eq $cpan_meta_pre) {
return $collector->with_merged_prereqs(
CPAN::Meta::Prereqs->new( $prereqs )
);
}
# Raw hashrefs
for my $phase ( keys %$prereqs ) {
for my $type ( keys %{ $prereqs->{$phase} } ) {
for my $module ( keys %{ $prereqs->{$phase}{$type} } ) {
$collector->{$phase}{$type}{$module} = $prereqs->{$phase}{$type}{$module};
}
}
}
return $collector;
}
my @include = qw(
);
my @exclude = qw(
);
# Add static prereqs to the included modules list
my $static_prereqs = do './t/00-report-prereqs.dd';
# Merge all prereqs (either with ::Prereqs or a hashref)
my $full_prereqs = _merge_prereqs(
( $HAS_CPAN_META ? $cpan_meta_pre->new : {} ),
$static_prereqs
);
# Add dynamic prereqs to the included modules list (if we can)
my ($source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
my $cpan_meta_error;
if ( $source && $HAS_CPAN_META
&& (my $meta = eval { CPAN::Meta->load_file($source) } )
) {
$full_prereqs = _merge_prereqs($full_prereqs, $meta->prereqs);
}
else {
$cpan_meta_error = $@; # capture error from CPAN::Meta->load_file($source)
$source = 'static metadata';
}
my @full_reports;
my @dep_errors;
my $req_hash = $HAS_CPAN_META ? $full_prereqs->as_string_hash : $full_prereqs;
# Add static includes into a fake section
for my $mod (@include) {
$req_hash->{other}{modules}{$mod} = 0;
}
for my $phase ( qw(configure build test runtime develop other) ) {
next unless $req_hash->{$phase};
next if ($phase eq 'develop' and not $ENV{AUTHOR_TESTING});
for my $type ( qw(requires recommends suggests conflicts modules) ) {
next unless $req_hash->{$phase}{$type};
my $title = ucfirst($phase).' '.ucfirst($type);
my @reports = [qw/Module Want Have/];
for my $mod ( sort keys %{ $req_hash->{$phase}{$type} } ) {
next if grep { $_ eq $mod } @exclude;
my $want = $req_hash->{$phase}{$type}{$mod};
$want = "undef" unless defined $want;
$want = "any" if !$want && $want == 0;
if ($mod eq 'perl') {
push @reports, ['perl', $want, $]];
next;
}
my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required";
my $file = $mod;
$file =~ s{::}{/}g;
$file .= ".pm";
my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC;
if ($prefix) {
my $have = MM->parse_version( File::Spec->catfile($prefix, $file) );
$have = "undef" unless defined $have;
push @reports, [$mod, $want, $have];
if ( $DO_VERIFY_PREREQS && $HAS_CPAN_META && $type eq 'requires' ) {
if ( $have !~ /\A$lax_version_re\z/ ) {
push @dep_errors, "$mod version '$have' cannot be parsed ($req_string)";
}
elsif ( ! $full_prereqs->requirements_for( $phase, $type )->accepts_module( $mod => $have ) ) {
push @dep_errors, "$mod version '$have' is not in required range '$want'";
}
}
}
else {
push @reports, [$mod, $want, "missing"];
if ( $DO_VERIFY_PREREQS && $type eq 'requires' ) {
push @dep_errors, "$mod is not installed ($req_string)";
}
}
}
if ( @reports ) {
push @full_reports, "=== $title ===\n\n";
my $ml = _max( map { length $_->[0] } @reports );
my $wl = _max( map { length $_->[1] } @reports );
my $hl = _max( map { length $_->[2] } @reports );
if ($type eq 'modules') {
splice @reports, 1, 0, ["-" x $ml, "", "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s\n", -$ml, $_->[0], $hl, $_->[2]) } @reports;
}
else {
splice @reports, 1, 0, ["-" x $ml, "-" x $wl, "-" x $hl];
push @full_reports, map { sprintf(" %*s %*s %*s\n", -$ml, $_->[0], $wl, $_->[1], $hl, $_->[2]) } @reports;
}
push @full_reports, "\n";
}
}
}
if ( @full_reports ) {
diag "\nVersions for all modules listed in $source (including optional ones):\n\n", @full_reports;
}
if ( $cpan_meta_error || @dep_errors ) {
diag "\n*** WARNING WARNING WARNING WARNING WARNING WARNING WARNING WARNING ***\n";
}
if ( $cpan_meta_error ) {
my ($orig_source) = grep { -f } 'MYMETA.json', 'MYMETA.yml';
diag "\nCPAN::Meta->load_file('$orig_source') failed with: $cpan_meta_error\n";
}
if ( @dep_errors ) {
diag join("\n",
"\nThe following REQUIRED prerequisites were not satisfied:\n",
@dep_errors,
"\n"
);
}
pass('Reported prereqs');
# vim: ts=4 sts=4 sw=4 et:
HTML-Form-6.12/t/form.t 0000644 0001750 0001750 00000040346 14704505176 013146 0 ustar olaf olaf #!perl
use strict;
use warnings;
use Test::More;
use HTML::Form;
my @warn;
$SIG{__WARN__} = sub { push( @warn, $_[0] ) };
my @f = HTML::Form->parse( "", "http://localhost/" );
is( @f, 0 );
@f = HTML::Form->parse( <<'EOT', "http://localhost/" );
EOT
is( @f, 2 );
my $f = shift @f;
is( $f->value("name"), "" );
is(
$f->dump,
"GET http://localhost/abc [foo]\n name= (text)\n"
);
my $req = $f->click;
is( $req->method, "GET" );
is( $req->uri, "http://localhost/abc?name=" );
$f->value( name => "Gisle Aas" );
$req = $f->click;
is( $req->method, "GET" );
is( $req->uri, "http://localhost/abc?name=Gisle+Aas" );
is( $f->attr("name"), "foo" );
is( $f->attr("method"), undef );
$f = shift @f;
is( $f->method, "GET" );
is( $f->action, "http://localhost/" );
is( $f->enctype, "application/x-www-form-urlencoded" );
is( $f->dump, "GET http://localhost/\n" );
# try some more advanced inputs
$f = HTML::Form->parse( <<'EOT', base => "http://localhost/", verbose => 1 );
abc
Foo
Bar
Foo
Bar
EOT
#print $f->dump;
#print $f->click->as_string;
is( $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
is( @warn, 1 );
like( $warn[0], qr/^Unknown input type 'xyzzy'/ );
@warn = ();
$f = HTML::Form->parse( <<'EOT', "http://localhost/" );
EOT
#$f->dump;
is( $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;
is( $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 my $file, ">", $filename || die;
binmode($file);
print $file "This is some text\n";
close($file) || die;
$f->value( f => $filename );
#print $f->click->as_string;
is( $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': $!";
is( @warn, 0 );
# Try to parse form HTTP::Response directly
{
package MyResponse;
require HTTP::Response;
our @ISA = ('HTTP::Response');
sub base { "http://www.example.com" }
}
my $response = MyResponse->new( 200, 'OK' );
$response->content(" ");
$f = HTML::Form->parse($response);
is( $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;
is( $f->click->as_string, <<"EOT");
GET http://www.example.com?x=on
EOT
$f->value( "x", "off" );
is( $f->click->as_string, <<"EOT");
GET http://www.example.com
EOT
$f->value( "x", "I like it!" );
is( $f->click->as_string, <<"EOT");
GET http://www.example.com?x=on
EOT
$f->value( "x", "I LIKE IT!" );
is( $f->click->as_string, <<"EOT");
GET http://www.example.com?x=on
EOT
$f = HTML::Form->parse( <
one
two
3
EOT
$f->value( "x", "one" );
is( $f->click->as_string, <<"EOT");
GET http://www.example.com?x=1
EOT
$f->value( "x", "TWO" );
is( $f->click->as_string, <<"EOT");
GET http://www.example.com?x=2
EOT
is( join( ":", $f->find_input("x")->value_names ), "one:two:3" );
is( join( ":", map $_->name, $f->find_input( undef, "option" ) ), "x:y" );
$f = HTML::Form->parse( <
EOT
is( $f->value("x"), 1 );
is( $f->value("y"), 2 );
is( $f->value("z"), 3 );
is( $f->click->uri->query, "y=2&z=3" );
my $input = $f->find_input("x");
is( $input->type, "text" );
ok( !$input->readonly );
ok( $input->disabled );
ok( $input->disabled(0) );
ok( !$input->disabled );
is( $f->click->uri->query, "x=1&y=2&z=3" );
$input = $f->find_input("y");
is( $input->type, "text" );
ok( $input->readonly );
ok( !$input->disabled );
$input->value(22);
is( $f->click->uri->query, "x=1&y=22&z=3" );
$input->strict(1);
eval { $input->value(23); };
like( $@, qr/^Input 'y' is readonly/ );
ok( $input->readonly(0) );
ok( !$input->readonly );
$input->value(222);
is( @warn, 0 );
is( $f->click->uri->query, "x=1&y=222&z=3" );
$input = $f->find_input("z");
is( $input->type, "hidden" );
ok( $input->readonly );
ok( !$input->disabled );
$f = HTML::Form->parse( <
Foo
Bar
EOT
is( $f->value("t"), "\n\n" );
is( $f->value("s"), "Foo" );
is( join( ":", $f->find_input("s")->possible_values ), "Foo:bar" );
is( join( ":", $f->find_input("s")->other_possible_values ), "bar" );
is( $f->value( "s", "bar" ), "Foo" );
is( $f->value("s"), "bar" );
is( join( ":", $f->find_input("s")->other_possible_values ), "" );
$f = HTML::Form->parse(
< "http://www.example.com", strict => 1 );
one
one
two
three
one
two
three
1
1
2
3
1
2
3
1
2
3
1
1
2
3
1
2
3
1
2
3
EOT
#print $f->dump;
ok( $f->find_input("r0")->disabled );
ok( !eval { $f->value( "r0", 1 ); } );
like( $@, qr/^The value '1' has been disabled for field 'r0'/ );
ok( $f->find_input("r0")->disabled(0) );
ok( !$f->find_input("r0")->disabled );
is( $f->value( "r0", 1 ), undef );
is( $f->value("r0"), 1 );
ok( !$f->find_input("r1")->disabled );
is( $f->value( "r1", 2 ), undef );
is( $f->value("r1"), 2 );
ok( !eval { $f->value( "r1", 1 ); } );
like( $@, qr/^The value '1' has been disabled for field 'r1'/ );
is( $f->value( "r2", 1 ), undef );
ok( !eval { $f->value( "r2", 2 ); } );
like( $@, qr/^The value '2' has been disabled for field 'r2'/ );
ok( !eval { $f->value( "r2", "two" ); } );
like( $@, qr/^The value 'two' has been disabled for field 'r2'/ );
ok( !$f->find_input("r2")->disabled(1) );
ok( !eval { $f->value( "r2", 1 ); } );
like( $@, qr/^The value '1' has been disabled for field 'r2'/ );
ok( $f->find_input("r2")->disabled(0) );
ok( !$f->find_input("r2")->disabled );
is( $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 ); } );
like( $@, qr/^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 );
is( $f->find_input( "m3", undef, 2 )->value(2), undef );
is( $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 );
is( eval { $f->find_input( "m3", undef, 2 )->value(2) }, undef );
like( $@, qr/^The value '2' has been disabled/ );
is( eval { $f->find_input( "m3", undef, 2 )->value(undef) }, undef );
like( $@, qr/^The 'm3' field can't be unchecked/ );
# multiple select with the same name [RT#18993]
$f = HTML::Form->parse( <
hi
mom
hi
mom
hi
mom
EOT
is( join( "|", $f->form ), "bug|hi|bug|mom|nobug|mom" );
# Try a disabled radiobutton:
$f = HTML::Form->parse( <
EOT
is( $f->click->as_string, <<'EOT');
GET http://localhost/?f=b
EOT
$f = HTML::Form->parse( <
EOT
ok( $f->find_input("randomkey") );
is( $f->find_input("randomkey")->challenge, "1234567890" );
is( $f->find_input("randomkey")->keytype, "rsa" );
is( $f->click->as_string, <value( randomkey => "foo" );
is( $f->click->as_string, <parse( <
1
2
EOT
ok($f);
ok( $f->find_input("t") );
@f = HTML::Form->parse( <
1
2
EOT
is( @f, 2 );
ok( $f[0]->find_input("s") );
ok( $f[1]->find_input("t") );
$f = HTML::Form->parse( <
Radio Buttons with Labels
zero
one
two
nested
before
and
after
EOT
is( join( ":", $f->find_input("r0")->value_names ), "zero" );
is( join( ":", $f->find_input("r1")->value_names ), "one" );
is( join( ":", $f->find_input("r2")->value_names ), "two" );
is( join( ":", $f->find_input("r3")->value_names ), "nested" );
is( join( ":", $f->find_input("r4")->value_names ), "before and after" );
$f = HTML::Form->parse( <
EOT
is( join( ":", $f->find_input("keep_informed")->value_names ), "off:" );
$f = HTML::Form->parse( <
One
Two
Three