1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
|
#!/opt/perl58/bin/perl -w
use Test::More 'no_plan';
package Catch;
sub TIEHANDLE {
my($class, $var) = @_;
return bless { var => $var }, $class;
}
sub PRINT {
my($self) = shift;
${'main::'.$self->{var}} .= join '', @_;
}
sub OPEN {} # XXX Hackery in case the user redirects
sub CLOSE {} # XXX STDERR/STDOUT. This is not the behavior we want.
sub READ {}
sub READLINE {}
sub GETC {}
sub BINMODE {}
my $Original_File = 'lib/WWW/Mechanize/FormFiller/Value/Interactive.pm';
package main;
# pre-5.8.0's warns aren't caught by a tied STDERR.
$SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; };
tie *STDOUT, 'Catch', '_STDOUT_' or die $!;
tie *STDERR, 'Catch', '_STDERR_' or die $!;
SKIP: {
# A header testing whether we find all prerequisites :
# Check for module WWW::Mechanize::FormFiller
eval { require WWW::Mechanize::FormFiller };
skip "Need module WWW::Mechanize::FormFiller to run this test", 1
if $@;
# Check for module WWW::Mechanize::FormFiller::Value::Interactive
eval { require WWW::Mechanize::FormFiller::Value::Interactive };
skip "Need module WWW::Mechanize::FormFiller::Value::Interactive to run this test", 1
if $@;
# The original POD test
undef $main::_STDOUT_;
undef $main::_STDERR_;
eval q{
my $example = sub {
local $^W = 0;
#line 36 lib/WWW/Mechanize/FormFiller/Value/Interactive.pm
use WWW::Mechanize::FormFiller;
use WWW::Mechanize::FormFiller::Value::Interactive;
my $f = WWW::Mechanize::FormFiller->new();
# Ask the user for the "login"
my $login = WWW::Mechanize::FormFiller::Value::Interactive->new( 'login' );
$f->add_value( login => $login );
# Alternatively take the following shorthand, which adds the
# field to the list as well :
# "Ask the user for the password"
my $password = $f->add_filler( password => 'Interactive' );
;
}
};
is($@, '', "example from line 36");
};
SKIP: {
# A header testing whether we find all prerequisites :
# Check for module HTML::Form
eval { require HTML::Form };
skip "Need module HTML::Form to run this test", 1
if $@;
# Check for module WWW::Mechanize::FormFiller
eval { require WWW::Mechanize::FormFiller };
skip "Need module WWW::Mechanize::FormFiller to run this test", 1
if $@;
# Check for module WWW::Mechanize::FormFiller::Value::Interactive
eval { require WWW::Mechanize::FormFiller::Value::Interactive };
skip "Need module WWW::Mechanize::FormFiller::Value::Interactive to run this test", 1
if $@;
# The original POD test
{
undef $main::_STDOUT_;
undef $main::_STDERR_;
#line 36 lib/WWW/Mechanize/FormFiller/Value/Interactive.pm
use WWW::Mechanize::FormFiller;
use WWW::Mechanize::FormFiller::Value::Interactive;
my $f = WWW::Mechanize::FormFiller->new();
# Ask the user for the "login"
my $login = WWW::Mechanize::FormFiller::Value::Interactive->new( 'login' );
$f->add_value( login => $login );
# Alternatively take the following shorthand, which adds the
# field to the list as well :
# "Ask the user for the password"
my $password = $f->add_filler( password => 'Interactive' );
require HTML::Form;
BEGIN { no warnings 'redefine'; *WWW::Mechanize::FormFiller::Value::Interactive::ask_value = sub {'fixed'}};
my $form = HTML::Form->parse('<html><body><form method=get action=/>
<input type=text name=login value=foo />
<input type=text name=password value=bar />
</form></body></html>','http://www.example.com/');
$f->fill_form($form);
is( $form->value('login'), "fixed", "Login gets set");
is( $form->value('password'), "fixed", "Password gets set");
undef $main::_STDOUT_;
undef $main::_STDERR_;
}
};
SKIP: {
# A header testing whether we find all prerequisites :
# The original POD test
undef $main::_STDOUT_;
undef $main::_STDERR_;
};
|