diff --git a/Changes b/Changes
index 3c91eb6..a878eb5 100644
--- a/Changes
+++ b/Changes
@@ -4,6 +4,12 @@ WWW::Mechanize and Test::WWW::Mechanize do not use rt.cpan.org for
bug tracking. They are now being tracked via Google Code at
http://code.google.com/p/www-mechanize/issues/list
+NEXT
+-----------------------------------
+[FIXES]
+stuff_inputs() used to do nothing. Now it works.
+http://code.google.com/p/www-mechanize/issues/detail?id=9
+
1.18 Thu Dec 6 10:12:14 CST 2007
------------------------------------
diff --git a/MANIFEST b/MANIFEST
index 7e799e0..2332760 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -22,6 +22,7 @@ t/page_links_content.t
t/page_links_ok.t
t/pod-coverage.t
t/pod.t
+t/stuff_inputs.html
t/stuff_inputs.t
t/submit_form_ok.t
diff --git a/Makefile.PL b/Makefile.PL
index e9580dd..5154252 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -37,7 +37,7 @@ sub MY::postamble {
.PHONY: critic tags
critic:
- perlcritic -1 -q -profile perlcriticrc bin/ lib/ t/
+ perlcritic -1 -q -profile perlcriticrc Mechanize.pm t/
tags:
ctags -f tags --recurse --totals \
diff --git a/Mechanize.pm b/Mechanize.pm
index 83d18d4..864912f 100644
--- a/Mechanize.pm
+++ b/Mechanize.pm
@@ -1063,7 +1063,7 @@ sub stuff_inputs {
}
}
- my @inputs = $self->find_all_inputs( type => qr/^(text|textarea|password)$/ );
+ my @inputs = $self->find_all_inputs( type_regex => qr/^(text|textarea|password)$/ );
foreach my $field ( @inputs ) {
next if $field->readonly();
diff --git a/t/stuff_inputs.html b/t/stuff_inputs.html
new file mode 100644
index 0000000..7df89cd
--- /dev/null
+++ b/t/stuff_inputs.html
@@ -0,0 +1,6 @@
+
+Title
+
+
+
diff --git a/t/stuff_inputs.t b/t/stuff_inputs.t
index 5524e3f..41e3932 100644
--- a/t/stuff_inputs.t
+++ b/t/stuff_inputs.t
@@ -1,56 +1,174 @@
-#!perl -w
+#!perl -Tw
use strict;
use warnings;
-use Test::More tests => 3;
-use Test::Builder::Tester;
-use URI::file;
-
-use constant PORT => 13432;
-$ENV{http_proxy} = ''; # All our tests are running on localhost
+use Test::More tests => 44;
+use URI::file;
BEGIN {
use_ok( 'Test::WWW::Mechanize' );
}
-my $server=TWMServer->new(PORT);
-my $pid=$server->background;
-ok($pid,'HTTP Server started') or die "Can't start the server";
-sleep 1; # $server->background() may come back prematurely, so give it a second to fire up
+my $mech = Test::WWW::Mechanize->new();
+my $uri = URI::file->new_abs( 't/stuff_inputs.html' )->as_string;
-sub cleanup { kill(9,$pid) if !$^S };
-$SIG{__DIE__}=\&cleanup;
+EMPTY_FIELDS: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
-my $mech=Test::WWW::Mechanize->new();
-isa_ok( $mech, 'Test::WWW::Mechanize' );
+ add_test_fields( $mech );
+ $mech->stuff_inputs();
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => '@' x 10,
+ text70k => '@' x 70000,
+ textunlimited => '@' x 66000,
+ textarea => '@' x 66000,
+ },
+ 'filling empty fields'
+ );
+}
-$mech->get('http://localhost:'.PORT.'/form.html');
-$mech->stuff_inputs();
+
+MULTICHAR_FILL: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( { fill => '123' } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '1',
+ text10 => '1231231231',
+ text70k => '123' x 23333 . '1',
+ textunlimited => '123' x 22000,
+ textarea => '123' x 22000,
+ },
+ 'multichar_fill'
+ );
+}
-cleanup();
+OVERWRITE: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs();
+ is( $mech->value('text10'), '@' x 10, 'overwriting fields: initial fill as expected' );
+ $mech->stuff_inputs( { fill => 'X' } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => 'X',
+ text10 => 'X' x 10,
+ text70k => 'X' x 70000,
+ textunlimited => 'X' x 66000,
+ textarea => 'X' x 66000,
+ },
+ 'overwriting fields'
+ );
+}
+
+
+CUSTOM_FILL: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( {
+ fill => 'z',
+ specs => {
+ text10 => { fill=>'#' },
+ textarea => { fill=>'*' },
+ }
+ } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => 'z',
+ text10 => '#' x 10,
+ text70k => 'z' x 70000,
+ textunlimited => 'z' x 66000,
+ textarea => '*' x 66000,
+ },
+ 'custom fill'
+ );
+}
-{
- package TWMServer;
- use base 'HTTP::Server::Simple::CGI';
- sub handle_request {
- my $self=shift;
- my $cgi=shift;
+MAXLENGTH: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( {
+ specs => {
+ text10 => { maxlength=>7 },
+ textarea => { fill=>'*', maxlength=>9 },
+ }
+ }
+ );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => '@' x 7,
+ text70k => '@' x 70000,
+ textunlimited => '@' x 66000,
+ textarea => '*' x 9,
+ },
+ 'maxlength'
+ );
+}
+
+
+IGNORE: {
+ $mech->get( $uri );
+ ok( $mech->success, "Fetched $uri" ) or die q{Can't get test page};
+
+ add_test_fields( $mech );
+ $mech->stuff_inputs( { ignore => [ 'text10' ] } );
+ field_checks(
+ $mech, {
+ text0 => '',
+ text1 => '@',
+ text10 => undef,
+ text70k => '@' x 70000,
+ textunlimited => '@' x 66000,
+ textarea => '@' x 66000,
+ },
+ 'ignore'
+ );
+}
+
+
+sub add_test_fields {
+ my $mech = shift;
+
+ HTML::Form::Input->new( type=>'text', name=>'text0', maxlength=>0 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text1', maxlength=>1 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text10', maxlength=>10 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'text70k', maxlength=>70000 )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'text', name=>'textunlimited' )->add_to_form( $mech->current_form() );
+ HTML::Form::Input->new( type=>'textarea', name=>'textarea' )->add_to_form( $mech->current_form() );
+
+ return;
+}
+
- my $file=(split('/',$cgi->path_info))[-1]||'index.html';
- $file=~s/\s+//g;
+sub field_checks {
+ my $mech = shift;
+ my $expected = shift;
+ my $desc = shift;
- if(-r "t/html/$file") {
- if(my $response=do { local (@ARGV, $/) = "t/html/$file"; <> }) {
- print "HTTP/1.0 200 OK\r\n";
- print "Content-Type: text/html\r\nContent-Length: ",
- length($response), "\r\n\r\n", $response;
- return;
- }
+ foreach my $key ( qw( text0 text1 text10 text70k textunlimited textarea ) ) {
+ is( $mech->value($key), $expected->{$key}, "$desc: field $key" );
}
- print "HTTP/1.0 404 Not Found\r\n\r\n";
- }
+ return;
}
diff --git a/tags b/tags
index 9558a7a..c80d72d 100644
--- a/tags
+++ b/tags
@@ -6,13 +6,19 @@
!_TAG_PROGRAM_VERSION 5.7 //
BAD_GET t/get_ok.t /^BAD_GET: {$/;" l
CONSTRUCTOR_PARMS t/new.t /^CONSTRUCTOR_PARMS: {$/;" l
+CUSTOM_FILL t/stuff_inputs.t /^CUSTOM_FILL: {$/;" l
+EMPTY_FIELDS t/stuff_inputs.t /^EMPTY_FIELDS: {$/;" l
FOLLOW_BAD_LINK t/follow_link_ok.t /^FOLLOW_BAD_LINK: {$/;" l
FOLLOW_GOOD_LINK t/follow_link_ok.t /^FOLLOW_GOOD_LINK: {$/;" l
GOOD_GET t/get_ok.t /^GOOD_GET: {$/;" l
GOOD_GET t/html_lint_ok.t /^GOOD_GET: {$/;" l
+IGNORE t/stuff_inputs.t /^IGNORE: {$/;" l
+MAXLENGTH t/stuff_inputs.t /^MAXLENGTH: {$/;" l
+MULTICHAR_FILL t/stuff_inputs.t /^MULTICHAR_FILL: {$/;" l
MY Makefile.PL /^sub MY::postamble {$/;" s
NEW t/new.t /^NEW: {$/;" l
NONEXISTENT t/get_ok.t /^use constant NONEXISTENT => 'http:\/\/blahblablah.xx-nonexistent.';$/;" c
+OVERWRITE t/stuff_inputs.t /^OVERWRITE: {$/;" l
PORT t/content_contains.t /^use constant PORT => 13432;$/;" c
PORT t/content_lacks.t /^use constant PORT => 13432;$/;" c
PORT t/follow_link_ok.t /^use constant PORT => 13432;$/;" c
@@ -24,7 +30,6 @@ PORT t/link_status.t /^use constant PORT => 13432;$/;" c
PORT t/links_ok.t /^use constant PORT => 13432;$/;" c
PORT t/page_links_content.t /^use constant PORT => 13432;$/;" c
PORT t/page_links_ok.t /^use constant PORT => 13432;$/;" c
-PORT t/stuff_inputs.t /^use constant PORT => 13432;$/;" c
PORT t/submit_form_ok.t /^use constant PORT => 13432;$/;" c
SUBMIT_GOOD_FORM t/submit_form_ok.t /^SUBMIT_GOOD_FORM: {$/;" l
TWMServer t/content_contains.t /^ package TWMServer;$/;" p
@@ -38,7 +43,6 @@ TWMServer t/link_status.t /^ package TWMServer;$/;" p
TWMServer t/links_ok.t /^ package TWMServer;$/;" p
TWMServer t/page_links_content.t /^ package TWMServer;$/;" p
TWMServer t/page_links_ok.t /^ package TWMServer;$/;" p
-TWMServer t/stuff_inputs.t /^ package TWMServer;$/;" p
TWMServer t/submit_form_ok.t /^ package TWMServer;$/;" p
Test t/get_ok-parms.t /^sub Test::WWW::Mechanize::get {$/;" s
Test t/get_ok-parms.t /^sub Test::WWW::Mechanize::success { return 1; }$/;" s
@@ -48,6 +52,7 @@ _check_links_status Mechanize.pm /^sub _check_links_status {$/;" s
_default_links_desc Mechanize.pm /^sub _default_links_desc {$/;" s
_format_links Mechanize.pm /^sub _format_links {$/;" s
_tag_walk Mechanize.pm /^sub _tag_walk {$/;" s
+add_test_fields t/stuff_inputs.t /^sub add_test_fields {$/;" s
base_is Mechanize.pm /^sub base_is {$/;" s
base_like Mechanize.pm /^sub base_like {$/;" s
base_unlike Mechanize.pm /^sub base_unlike {$/;" s
@@ -63,7 +68,6 @@ cleanup t/link_status.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
cleanup t/links_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
cleanup t/page_links_content.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
cleanup t/page_links_ok.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
-cleanup t/stuff_inputs.t /^sub cleanup { kill(9,$pid) if !$^S };$/;" s
cleanup t/submit_form_ok.t /^sub cleanup { kill(9,$pid) };$/;" s
content_contains Mechanize.pm /^sub content_contains {$/;" s
content_is Mechanize.pm /^sub content_is {$/;" s
@@ -71,6 +75,7 @@ content_lacks Mechanize.pm /^sub content_lacks {$/;" s
content_like Mechanize.pm /^sub content_like {$/;" s
content_unlike Mechanize.pm /^sub content_unlike {$/;" s
critic Makefile.PL /^critic:$/;" l
+field_checks t/stuff_inputs.t /^sub field_checks {$/;" s
follow_link_ok Mechanize.pm /^sub follow_link_ok {$/;" s
followable_links Mechanize.pm /^sub followable_links {$/;" s
get_ok Mechanize.pm /^sub get_ok {$/;" s
@@ -85,7 +90,6 @@ handle_request t/link_status.t /^ sub handle_request {$/;" s
handle_request t/links_ok.t /^ sub handle_request {$/;" s
handle_request t/page_links_content.t /^ sub handle_request {$/;" s
handle_request t/page_links_ok.t /^ sub handle_request {$/;" s
-handle_request t/stuff_inputs.t /^ sub handle_request {$/;" s
handle_request t/submit_form_ok.t /^ sub handle_request {$/;" s
has_tag Mechanize.pm /^sub has_tag {$/;" s
has_tag_like Mechanize.pm /^sub has_tag_like {$/;" s