HTML-Form-6.11/0000775000175000017500000000000014371700302013607 5ustar simbabquesimbabqueHTML-Form-6.11/lib/0000775000175000017500000000000014371700302014355 5ustar simbabquesimbabqueHTML-Form-6.11/lib/HTML/0000775000175000017500000000000014371700302015121 5ustar simbabquesimbabqueHTML-Form-6.11/lib/HTML/Form/0000775000175000017500000000000014371700302016024 5ustar simbabquesimbabqueHTML-Form-6.11/lib/HTML/Form/ImageInput.pm0000644000175000017500000000166314371700302020430 0ustar simbabquesimbabquepackage HTML::Form::ImageInput; use strict; use parent 'HTML::Form::SubmitInput'; our $VERSION = '6.11'; # ABSTRACT: An HTML form image input element for use with HTML::Form sub form_name_value { my $self = shift; my $clicked = $self->{clicked}; return unless $clicked; return if $self->{disabled}; my $name = $self->{name}; $name = ( defined($name) && length($name) ) ? "$name." : ""; return ( "${name}x" => $clicked->[0], "${name}y" => $clicked->[1] ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::ImageInput - An HTML form image input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/IgnoreInput.pm0000644000175000017500000000140514371700302020623 0ustar simbabquesimbabquepackage HTML::Form::IgnoreInput; use strict; use parent 'HTML::Form::Input'; our $VERSION = '6.11'; # ABSTRACT: An HTML form ignored input element for use with HTML::Form # This represents buttons and resets whose values shouldn't matter # but should buttons not be like submits?! #input/button #input/reset sub value { return } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::IgnoreInput - An HTML form ignored input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/Input.pm0000644000175000017500000000670214371700302017464 0ustar simbabquesimbabquepackage HTML::Form::Input; use strict; our $VERSION = '6.11'; # ABSTRACT: A generic HTML form input element for use with HTML::Form sub new { my $class = shift; my $self = bless {@_}, $class; $self; } sub add_to_form { my ( $self, $form ) = @_; push( @{ $form->{'inputs'} }, $self ); $self; } sub strict { my $self = shift; my $old = $self->{strict}; if (@_) { $self->{strict} = shift; } $old; } sub fixup { } sub type { shift->{type}; } sub name { my $self = shift; my $old = $self->{name}; $self->{name} = shift if @_; $old; } sub id { my $self = shift; my $old = $self->{id}; $self->{id} = shift if @_; $old; } sub class { my $self = shift; my $old = $self->{class}; $self->{class} = shift if @_; $old; } sub selected { my ( $self, $sel ) = @_; return undef unless defined $sel; my $attr = $sel =~ s/^\^// ? "name" : $sel =~ s/^#// ? "id" : $sel =~ s/^\.// ? "class" : "name"; return 0 unless defined $self->{$attr}; return $self->{$attr} eq $sel; } sub value { my $self = shift; my $old = $self->{value}; $self->{value} = shift if @_; $old; } sub autocomplete { my $self = shift; my $old = $self->{autocomplete}; $self->{autocomplete} = shift if @_; $old; } sub possible_values { return; } sub other_possible_values { return; } sub value_names { return; } sub readonly { my $self = shift; my $old = $self->{readonly}; $self->{readonly} = shift if @_; $old; } sub disabled { my $self = shift; my $old = $self->{disabled}; $self->{disabled} = shift if @_; $old; } sub form_name_value { my $self = shift; my $name = $self->{'name'}; return unless defined $name; return if $self->disabled; my $value = $self->value; return unless defined $value; return ( $name => $value ); } sub dump { my $self = shift; my $name = $self->name; $name = "" unless defined $name; my $value = $self->value; $value = "" unless defined $value; my $dump = "$name=$value"; my $type = $self->type; $type .= " disabled" if $self->disabled; $type .= " readonly" if $self->readonly; return sprintf "%-30s %s", $dump, "($type)" unless $self->{menu}; my @menu; my $i = 0; for ( @{ $self->{menu} } ) { my $opt = $_->{value}; $opt = "" unless defined $opt; $opt .= "/$_->{name}" if defined $_->{name} && length $_->{name} && $_->{name} ne $opt; substr( $opt, 0, 0 ) = "-" if $_->{disabled}; if ( exists $self->{current} && $self->{current} == $i ) { substr( $opt, 0, 0 ) = "!" unless $_->{seen}; substr( $opt, 0, 0 ) = "*"; } else { substr( $opt, 0, 0 ) = ":" if $_->{seen}; } push( @menu, $opt ); $i++; } return sprintf "%-30s %-10s %s", $dump, "($type)", "[" . join( "|", @menu ) . "]"; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::Input - A generic HTML form input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/FileInput.pm0000644000175000017500000000406014371700302020257 0ustar simbabquesimbabquepackage HTML::Form::FileInput; use strict; use parent 'HTML::Form::TextInput'; our $VERSION = '6.11'; # ABSTRACT: An HTML form file input element for use with HTML::Form sub file { my $self = shift; $self->value(@_); } sub filename { my $self = shift; my $old = $self->{filename}; $self->{filename} = shift if @_; $old = $self->file unless defined $old; $old; } sub content { my $self = shift; my $old = $self->{content}; $self->{content} = shift if @_; $old; } sub headers { my $self = shift; my $old = $self->{headers} || []; $self->{headers} = [@_] if @_; @$old; } sub form_name_value { my ( $self, $form ) = @_; return $self->SUPER::form_name_value($form) if $form->method ne "POST" || $form->enctype ne "multipart/form-data"; my $name = $self->name; return unless defined $name; return if $self->{disabled}; my $file = $self->file; my $filename = $self->filename; my @headers = $self->headers; my $content = $self->content; my %headers = @headers; if ( defined $content || grep m/^Content$/i, keys %headers ) { $filename = $file unless defined $filename; $file = undef; unshift( @headers, "Content" => $content ); } elsif ( !defined($file) || length($file) == 0 ) { return; } # legacy (this used to be the way to do it) if ( ref($file) eq "ARRAY" ) { my $f = shift @$file; my $fn = shift @$file; push( @headers, @$file ); $file = $f; $filename = $fn; } return ( $name => [ $file, $filename, @headers ] ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::FileInput - An HTML form file input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/KeygenInput.pm0000644000175000017500000000137514371700302020630 0ustar simbabquesimbabquepackage HTML::Form::KeygenInput; use strict; use parent 'HTML::Form::Input'; our $VERSION = '6.11'; # ABSTRACT: An HTML form keygen input element for use with HTML::Form sub challenge { my $self = shift; return $self->{challenge}; } sub keytype { my $self = shift; return lc( $self->{keytype} || 'rsa' ); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::KeygenInput - An HTML form keygen input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/TextInput.pm0000644000175000017500000000227514371700302020332 0ustar simbabquesimbabquepackage HTML::Form::TextInput; use strict; use parent 'HTML::Form::Input'; our $VERSION = '6.11'; # ABSTRACT: An HTML form text input element for use with HTML::Form #input/text #input/password #input/hidden #textarea sub value { my $self = shift; my $old = $self->{value}; $old = "" unless defined $old; if (@_) { Carp::croak("Input '$self->{name}' is readonly") if $self->{strict} && $self->{readonly}; my $new = shift; my $n = exists $self->{maxlength} ? $self->{maxlength} : undef; Carp::croak("Input '$self->{name}' has maxlength '$n'") if $self->{strict} && defined($n) && defined($new) && length($new) > $n; $self->{value} = $new; } $old; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::TextInput - An HTML form text input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/SubmitInput.pm0000644000175000017500000000176014371700302020647 0ustar simbabquesimbabquepackage HTML::Form::SubmitInput; use strict; use parent 'HTML::Form::Input'; our $VERSION = '6.11'; # ABSTRACT: An HTML form submit input element for use with HTML::Form #input/image #input/submit sub click { my ( $self, $form, $x, $y ) = @_; for ( $x, $y ) { $_ = 1 unless defined; } local ( $self->{clicked} ) = [ $x, $y ]; local ( $self->{value} ) = "" unless defined $self->value; return $form->make_request; } sub form_name_value { my $self = shift; return unless $self->{clicked}; return $self->SUPER::form_name_value(@_); } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::SubmitInput - An HTML form submit input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form/ListInput.pm0000644000175000017500000001470514371700302020322 0ustar simbabquesimbabquepackage HTML::Form::ListInput; use strict; use parent 'HTML::Form::Input'; use Carp 'croak'; our $VERSION = '6.11'; # ABSTRACT: An HTML form list input element for use with HTML::Form #select/option (val1, val2, ....) #input/radio (undef, val1, val2,...) #input/checkbox (undef, value) #select-multiple/option (undef, value) sub new { my $class = shift; my $self = $class->SUPER::new(@_); my $value = delete $self->{value}; my $value_name = delete $self->{value_name}; my $type = $self->{type}; if ( $type eq "checkbox" ) { $value = "on" unless defined $value; $self->{menu} = [ { value => undef, name => "off", }, { value => $value, name => $value_name, }, ]; $self->{current} = ( delete $self->{checked} ) ? 1 : 0; } else { $self->{option_disabled}++ if $type eq "radio" && delete $self->{disabled}; $self->{menu} = [ { value => $value, name => $value_name }, ]; my $checked = $self->{checked} || $self->{option_selected}; delete $self->{checked}; delete $self->{option_selected}; if ( exists $self->{multiple} ) { unshift( @{ $self->{menu} }, { value => undef, name => "off" } ); $self->{current} = $checked ? 1 : 0; } else { $self->{current} = 0 if $checked; } } $self; } sub add_to_form { my ( $self, $form ) = @_; my $type = $self->type; return $self->SUPER::add_to_form($form) if $type eq "checkbox"; if ( $type eq "option" && exists $self->{multiple} ) { $self->{disabled} ||= delete $self->{option_disabled}; return $self->SUPER::add_to_form($form); } Carp::croak "Assert" if @{ $self->{menu} } != 1; my $m = $self->{menu}[0]; $m->{disabled}++ if delete $self->{option_disabled}; # if there was no name we have to search for an input that explicitly has # no name either, because otherwise the name attribute would be ignored my $prev = $form->find_input( $self->{name} || \undef, $self->{type}, $self->{idx} ); return $self->SUPER::add_to_form($form) unless $prev; # merge menus $prev->{current} = @{ $prev->{menu} } if exists $self->{current}; push( @{ $prev->{menu} }, $m ); } sub fixup { my $self = shift; if ( $self->{type} eq "option" && !( exists $self->{current} ) ) { $self->{current} = 0; } $self->{menu}[ $self->{current} ]{seen}++ if exists $self->{current}; } sub disabled { my $self = shift; my $type = $self->type; my $old = $self->{disabled} || _menu_all_disabled( @{ $self->{menu} } ); if (@_) { my $v = shift; $self->{disabled} = $v; for ( @{ $self->{menu} } ) { $_->{disabled} = $v; } } return $old; } sub _menu_all_disabled { for (@_) { return 0 unless $_->{disabled}; } return 1; } sub value { my $self = shift; my $old; $old = $self->{menu}[ $self->{current} ]{value} if exists $self->{current}; $old = $self->{value} if exists $self->{value}; if (@_) { my $i = 0; my $val = shift; my $cur; my $disabled; for ( @{ $self->{menu} } ) { if ( ( defined($val) && defined( $_->{value} ) && $val eq $_->{value} ) || ( !defined($val) && !defined( $_->{value} ) ) ) { $cur = $i; $disabled = $_->{disabled}; last unless $disabled; } $i++; } if ( !( defined $cur ) || $disabled ) { if ( defined $val ) { # try to search among the alternative names as well my $i = 0; my $cur_ignorecase; my $lc_val = lc($val); for ( @{ $self->{menu} } ) { if ( defined $_->{name} ) { if ( $val eq $_->{name} ) { $disabled = $_->{disabled}; $cur = $i; last unless $disabled; } if ( !defined($cur_ignorecase) && $lc_val eq lc( $_->{name} ) ) { $cur_ignorecase = $i; } } $i++; } unless ( defined $cur ) { $cur = $cur_ignorecase; if ( defined $cur ) { $disabled = $self->{menu}[$cur]{disabled}; } elsif ( $self->{strict} ) { my $n = $self->name; Carp::croak("Illegal value '$val' for field '$n'"); } } } elsif ( $self->{strict} ) { my $n = $self->name; Carp::croak("The '$n' field can't be unchecked"); } } if ( $self->{strict} && $disabled ) { my $n = $self->name; Carp::croak("The value '$val' has been disabled for field '$n'"); } if ( defined $cur ) { $self->{current} = $cur; $self->{menu}[$cur]{seen}++; delete $self->{value}; } else { $self->{value} = $val; delete $self->{current}; } } $old; } sub check { my $self = shift; $self->{current} = 1; $self->{menu}[1]{seen}++; } sub possible_values { my $self = shift; map $_->{value}, grep !$_->{disabled}, @{ $self->{menu} }; } sub other_possible_values { my $self = shift; map $_->{value}, grep !$_->{seen} && !$_->{disabled}, @{ $self->{menu} }; } sub value_names { my $self = shift; my @names; for ( @{ $self->{menu} } ) { my $n = $_->{name}; $n = $_->{value} unless defined $n; push( @names, $n ); } @names; } 1; __END__ =pod =encoding UTF-8 =head1 NAME HTML::Form::ListInput - An HTML form list input element for use with HTML::Form =head1 VERSION version 6.11 =head1 AUTHOR Gisle Aas =head1 COPYRIGHT AND LICENSE This software is copyright (c) 1998 by Gisle Aas. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. =cut HTML-Form-6.11/lib/HTML/Form.pm0000644000175000017500000010115514371700302016363 0ustar simbabquesimbabquepackage HTML::Form; use strict; use URI; use Carp (); use Encode (); use HTML::Form::TextInput (); use HTML::Form::IgnoreInput (); use HTML::Form::ListInput (); use HTML::Form::SubmitInput (); use HTML::Form::ImageInput (); use HTML::Form::FileInput (); use HTML::Form::KeygenInput (); our $VERSION = '6.11'; my %form_tags = map { $_ => 1 } qw(input textarea button select option); my %type2class = ( text => "TextInput", password => "TextInput", hidden => "TextInput", textarea => "TextInput", "reset" => "IgnoreInput", radio => "ListInput", checkbox => "ListInput", option => "ListInput", button => "SubmitInput", submit => "SubmitInput", image => "ImageInput", file => "FileInput", keygen => "KeygenInput", ); # The new HTML5 input types %type2class = ( %type2class, map { $_ => 'TextInput' } qw( tel search url email datetime date month week time datetime-local number range color ) ); # ABSTRACT: Class that represents an HTML form element sub parse { my $class = shift; my $html = shift; unshift( @_, "base" ) if @_ == 1; my %opt = @_; require HTML::TokeParser; my $p = HTML::TokeParser->new( ref($html) ? $html->decoded_content( ref => 1 ) : \$html ); Carp::croak "Failed to create HTML::TokeParser object" unless $p; my $base_uri = delete $opt{base}; my $charset = delete $opt{charset}; my $strict = delete $opt{strict}; my $verbose = delete $opt{verbose}; if ($^W) { Carp::carp("Unrecognized option $_ in HTML::Form->parse") for sort keys %opt; } unless ( defined $base_uri ) { if ( ref($html) ) { $base_uri = $html->base; } else { Carp::croak("HTML::Form::parse: No \$base_uri provided"); } } unless ( defined $charset ) { if ( ref($html) and $html->can("content_charset") ) { $charset = $html->content_charset; } unless ($charset) { $charset = "UTF-8"; } } my @forms; my $f; # current form my %openselect; # index to the open instance of a select while ( my $t = $p->get_tag ) { my ( $tag, $attr ) = @$t; if ( $tag eq "form" ) { my $action = delete $attr->{'action'}; $action = "" unless defined $action; $action = URI->new_abs( $action, $base_uri ); $f = $class->new( $attr->{'method'}, $action, $attr->{'enctype'} ); $f->accept_charset( $attr->{'accept-charset'} ) if $attr->{'accept-charset'}; $f->{default_charset} = $charset; $f->{attr} = $attr; $f->strict(1) if $strict; %openselect = (); push( @forms, $f ); my ( %labels, $current_label ); while ( my $t = $p->get_tag ) { my ( $tag, $attr ) = @$t; last if $tag eq "/form"; if ( $tag ne 'textarea' ) { # if we are inside a label tag, then keep # appending any text to the current label if ( defined $current_label ) { $current_label = join " ", grep { defined and length } $current_label, $p->get_phrase; } } if ( $tag eq "input" ) { $attr->{value_name} = exists $attr->{id} && exists $labels{ $attr->{id} } ? $labels{ $attr->{id} } : defined $current_label ? $current_label : $p->get_phrase; } if ( $tag eq "label" ) { $current_label = $p->get_phrase; $labels{ $attr->{for} } = $current_label if exists $attr->{for}; } elsif ( $tag eq "/label" ) { $current_label = undef; } elsif ( $tag eq "input" ) { my $type = delete $attr->{type} || "text"; $f->push_input( $type, $attr, $verbose ); } elsif ( $tag eq "button" ) { my $type = delete $attr->{type} || "submit"; $f->push_input( $type, $attr, $verbose ); } elsif ( $tag eq "textarea" ) { $attr->{textarea_value} = $attr->{value} if exists $attr->{value}; my $text = $p->get_text("/textarea"); $attr->{value} = $text; $f->push_input( "textarea", $attr, $verbose ); } elsif ( $tag eq "select" ) { # rename attributes reserved to come for the option tag for ( "value", "value_name" ) { $attr->{"select_$_"} = delete $attr->{$_} if exists $attr->{$_}; } # count this new select option separately my $name = $attr->{name}; $name = "" unless defined $name; $openselect{$name}++; while ( $t = $p->get_tag ) { my $tag = shift @$t; last if $tag eq "/select"; next if $tag =~ m,/?optgroup,; next if $tag eq "/option"; if ( $tag eq "option" ) { my %a = %{ $t->[0] }; # rename keys so they don't clash with %attr for ( keys %a ) { next if $_ eq "value"; $a{"option_$_"} = delete $a{$_}; } while ( my ( $k, $v ) = each %$attr ) { $a{$k} = $v; } $a{value_name} = $p->get_trimmed_text; $a{value} = delete $a{value_name} unless defined $a{value}; $a{idx} = $openselect{$name}; $f->push_input( "option", \%a, $verbose ); } else { warn("Bad here, so we # try to do the same. Actually the MSIE behaviour # appears really strange: and EOT is( $form->param('tt'), 'test content' ); } HTML-Form-6.11/t/form-param.t0000644000175000017500000000561114371700302016301 0ustar simbabquesimbabque#!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.11/t/file_upload.txt0000644000175000017500000000003114371700302017066 0ustar simbabquesimbabqueFirst line. Second line. HTML-Form-6.11/t/00-report-prereqs.t0000644000175000017500000001345214371700302017451 0ustar simbabquesimbabque#!perl use strict; use warnings; # This test was generated by Dist::Zilla::Plugin::Test::ReportPrereqs 0.028 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 $mod eq 'perl'; next if grep { $_ eq $mod } @exclude; my $file = $mod; $file =~ s{::}{/}g; $file .= ".pm"; my ($prefix) = grep { -e File::Spec->catfile($_, $file) } @INC; my $want = $req_hash->{$phase}{$type}{$mod}; $want = "undef" unless defined $want; $want = "any" if !$want && $want == 0; my $req_string = $want eq 'any' ? 'any version required' : "version '$want' required"; 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.11/t/find_input.t0000644000175000017500000000143214371700302016374 0ustar simbabquesimbabque#!/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.11/t/form.t0000644000175000017500000004034614371700302015207 0ustar simbabquesimbabque#!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 );
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( < 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( < one one two three one two three 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( < 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( < EOT ok($f); ok( $f->find_input("t") ); @f = HTML::Form->parse( < EOT is( @f, 2 ); ok( $f[0]->find_input("s") ); ok( $f[1]->find_input("t") ); $f = HTML::Form->parse( <
Radio Buttons with Labels
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( <
    Keep me informed on the progress of this election

The place you are registered to vote:
County or Parish Note 2
EOT is( join( ":", $f->find_input("keep_informed")->value_names ), "off:" ); $f = HTML::Form->parse( < EOT is( join( ":", $f->find_input("test")->possible_values ), "1:2" ); is( join( ":", $f->find_input("test")->other_possible_values ), "2" ); @warn = (); $f = HTML::Form->parse( < EOT is( @warn, 0 ); $f = HTML::Form->parse( < "http://localhost/" );
EOT is( $f->click->as_string, <parse( < "http://localhost/" );
EOT is( $f->click->as_string, <parse( < EOT TODO: { local $TODO = 'input with empty name should not be included'; is( join( "|", $f->form ), "foo|option in named", "options in unnamed selects are ignored" ); } # explicitly selecting an input that has no name my @nameless_inputs = $f->find_input( \undef ); is( scalar @nameless_inputs, 3, 'find_input with ref to undef finds three forms' ); ok( ( !grep { $_->{name} } @nameless_inputs ), '... and none of them has a name' ); ok( !( scalar $f->find_input( \undef ) )->{name}, 'find_input with ref to undef in scalar context' ); TODO: { local $TODO = 'input with empty name should not be included'; is( $f->click->as_string, <<"EOT"); GET http://localhost/target.html?foo=option+in+named EOT } done_testing;HTML-Form-6.11/t/form-unicode.t0000644000175000017500000000362114371700302016626 0ustar simbabquesimbabque#!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.11/t/00-report-prereqs.dd0000644000175000017500000000576514371700302017605 0ustar simbabquesimbabquedo { 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.11/t/form-maxlength.t0000644000175000017500000000342714371700302017173 0ustar simbabquesimbabque#!/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__
Login:
Password
remember me
password reminder
Create A New User
HTML-Form-6.11/t/autocomplete.t0000644000175000017500000000142014371700302016733 0ustar simbabquesimbabque#!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.11/t/form-selector.t0000644000175000017500000000203114371700302017012 0ustar simbabquesimbabque#!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.11/t/form-multi-select.t0000644000175000017500000000522114371700302017605 0ustar simbabquesimbabque#!/usr/bin/perl # Test for case when multiple forms are on a page with same-named }; 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.11/Makefile.PL0000644000175000017500000000316214371700302015561 0ustar simbabquesimbabque# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.025. use strict; use warnings; use 5.008001; use ExtUtils::MakeMaker; my %WriteMakefileArgs = ( "ABSTRACT" => "Class that represents an HTML form element", "AUTHOR" => "Gisle Aas ", "CONFIGURE_REQUIRES" => { "ExtUtils::MakeMaker" => 0 }, "DISTNAME" => "HTML-Form", "LICENSE" => "perl", "MIN_PERL_VERSION" => "5.008001", "NAME" => "HTML::Form", "PREREQ_PM" => { "Carp" => 0, "Encode" => 2, "HTML::TokeParser" => 0, "HTTP::Request" => 6, "HTTP::Request::Common" => "6.03", "Test::More" => "0.96", "URI" => "1.10", "parent" => 0, "strict" => 0 }, "TEST_REQUIRES" => { "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "HTTP::Response" => 0, "Test::More" => "0.96", "Test::Warnings" => 0, "warnings" => 0 }, "VERSION" => "6.11", "test" => { "TESTS" => "t/*.t" } ); my %FallbackPrereqs = ( "Carp" => 0, "Encode" => 2, "ExtUtils::MakeMaker" => 0, "File::Spec" => 0, "HTML::TokeParser" => 0, "HTTP::Request" => 6, "HTTP::Request::Common" => "6.03", "HTTP::Response" => 0, "Test::More" => "0.96", "Test::Warnings" => 0, "URI" => "1.10", "parent" => 0, "strict" => 0, "warnings" => 0 ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) { delete $WriteMakefileArgs{TEST_REQUIRES}; delete $WriteMakefileArgs{BUILD_REQUIRES}; $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs; } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); HTML-Form-6.11/MANIFEST0000644000175000017500000000161714371700302014743 0ustar simbabquesimbabque# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.025. Changes INSTALL LICENSE MANIFEST META.json META.yml Makefile.PL cpanfile dist.ini lib/HTML/Form.pm lib/HTML/Form/FileInput.pm lib/HTML/Form/IgnoreInput.pm lib/HTML/Form/ImageInput.pm lib/HTML/Form/Input.pm lib/HTML/Form/KeygenInput.pm lib/HTML/Form/ListInput.pm lib/HTML/Form/SubmitInput.pm lib/HTML/Form/TextInput.pm perltidyrc t/00-report-prereqs.dd t/00-report-prereqs.t t/autocomplete.t t/file_upload.t t/file_upload.txt t/find_input.t t/form-label.t t/form-maxlength.t t/form-multi-select.t t/form-param.t t/form-parse.t t/form-selector.t t/form-unicode.t t/form.t xt/author/00-compile.t xt/author/eol.t xt/author/minimum-version.t xt/author/mojibake.t xt/author/no-tabs.t xt/author/pod-coverage.t xt/author/pod-spell.t xt/author/pod-syntax.t xt/author/portability.t xt/author/test-version.t xt/release/changes_has_content.t HTML-Form-6.11/INSTALL0000644000175000017500000000452614371700302014645 0ustar simbabquesimbabqueThis is the Perl distribution HTML-Form. Installing HTML-Form is straightforward. ## Installation with cpanm If you have cpanm, you only need one line: % cpanm HTML::Form If it does not have permission to install modules to the current perl, cpanm will automatically set up and install to a local::lib in your home directory. See the local::lib documentation (https://metacpan.org/pod/local::lib) for details on enabling it in your environment. ## Installing with the CPAN shell Alternatively, if your CPAN shell is set up, you should just be able to do: % cpan HTML::Form ## Manual installation As a last resort, you can manually install it. If you have not already downloaded the release tarball, you can find the download link on the module's MetaCPAN page: https://metacpan.org/pod/HTML::Form Untar the tarball, install configure prerequisites (see below), then build it: % perl Makefile.PL % make && make test Then install it: % make install On Windows platforms, you should use `dmake` or `nmake`, instead of `make`. If your perl is system-managed, you can create a local::lib in your home directory to install modules to. For details, see the local::lib documentation: https://metacpan.org/pod/local::lib The prerequisites of this distribution will also have to be installed manually. The prerequisites are listed in one of the files: `MYMETA.yml` or `MYMETA.json` generated by running the manual build process described above. ## Configure Prerequisites This distribution requires other modules to be installed before this distribution's installer can be run. They can be found under the "configure_requires" key of META.yml or the "{prereqs}{configure}{requires}" key of META.json. ## Other Prerequisites This distribution may require additional modules to be installed after running Makefile.PL. Look for prerequisites in the following phases: * to run make, PHASE = build * to use the module code itself, PHASE = runtime * to run tests, PHASE = test They can all be found in the "PHASE_requires" key of MYMETA.yml or the "{prereqs}{PHASE}{requires}" key of MYMETA.json. ## Documentation HTML-Form documentation is available as POD. You can run `perldoc` from a shell to read the documentation: % perldoc HTML::Form For more information on installing Perl modules via CPAN, please see: https://www.cpan.org/modules/INSTALL.html HTML-Form-6.11/cpanfile0000644000175000017500000000312214371700302015307 0ustar simbabquesimbabque# This file is generated by Dist::Zilla::Plugin::CPANFile v6.025 # Do not edit this file directly. To change prereqs, edit the `dist.ini` file. requires "Carp" => "0"; requires "Encode" => "2"; requires "HTML::TokeParser" => "0"; requires "HTTP::Request" => "6"; requires "HTTP::Request::Common" => "6.03"; requires "Test::More" => "0.96"; requires "URI" => "1.10"; requires "parent" => "0"; requires "perl" => "5.008001"; requires "strict" => "0"; on 'test' => sub { requires "ExtUtils::MakeMaker" => "0"; requires "File::Spec" => "0"; requires "HTTP::Response" => "0"; requires "Test::More" => "0.96"; requires "Test::Warnings" => "0"; requires "warnings" => "0"; }; on 'test' => sub { recommends "CPAN::Meta" => "2.120900"; }; on 'configure' => sub { requires "ExtUtils::MakeMaker" => "0"; }; on 'configure' => sub { suggests "JSON::PP" => "2.27300"; }; on 'develop' => sub { requires "File::Spec" => "0"; requires "IO::Handle" => "0"; requires "IPC::Open3" => "0"; requires "Pod::Coverage::TrustPod" => "0"; requires "Pod::Wordlist" => "0"; requires "Test::EOL" => "0"; requires "Test::MinimumVersion" => "0"; requires "Test::Mojibake" => "0"; requires "Test::More" => "0.94"; requires "Test::NoTabs" => "0"; requires "Test::Pod" => "1.41"; requires "Test::Pod::Coverage" => "1.08"; requires "Test::Portability::Files" => "0"; requires "Test::Spelling" => "0.12"; requires "Test::Version" => "1"; requires "perl" => "5.006"; requires "warnings" => "0"; }; on 'develop' => sub { recommends "Dist::Zilla::PluginBundle::Git::VersionManager" => "0.007"; };