#!/usr/bin/perl -w use strict; use FindBin; use lib 'inc'; use IO::Catch; use File::Temp qw( tempfile ); use vars qw( %tests $_STDOUT_ $_STDERR_ ); use URI::URL; use LWP::Simple; # pre-5.8.0's warns aren't caught by a tied STDERR. $SIG{__WARN__} = sub { $main::_STDERR_ .= join '', @_; }; tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!; tie *STDERR, 'IO::Catch', '_STDERR_' or die $!; BEGIN { %tests = ( interactive_script_creation => { requests => 2, lines => [ 'eval @::list=qw(1 2 3 4 5 6 7 8 9 10 foo NY 11 DE 13 V 15 16 2038-01-01)', 'eval no warnings qw"once redefine"; *WWW::Mechanize::FormFiller::Value::Ask::ask_value = sub { #warn "Filled out ",$_[1]->name; my $value=shift @::list || "empty"; push @{$_[0]->{shell}->{answers}}, [ $_[1]->name, $value ]; $value }', 'get %s', 'fillout', 'submit', 'content' ], location => '%sgift_card/alphasite/www/cgi-bin/giftcard.cgi/checkout_process' }, ); }; use Test::More tests => 1 + (scalar keys %tests)*6; BEGIN { delete $ENV{PAGER}; $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); }; SKIP: { # Disable all ReadLine functionality my $HTML = do { local $/; }; eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test script/code identity",(scalar keys %tests)*6 if ($@); require Test::HTTP::LocalServer; # from inc # We want to be safe from non-resolving local host names delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; my $actual_requests; { no warnings 'redefine'; my $old_request = *WWW::Mechanize::request{CODE}; *WWW::Mechanize::request = sub { $actual_requests++; goto &$old_request; }; *WWW::Mechanize::Shell::status = sub {}; }; for my $name (sort keys %tests) { $_STDOUT_ = ''; undef $_STDERR_; $actual_requests = 0; my @lines = @{$tests{$name}->{lines}}; my $requests = $tests{$name}->{requests}; my $server = Test::HTTP::LocalServer->spawn( html => $HTML ); my $code_port = $server->port; my $result_location = sprintf $tests{$name}->{location}, $server->url; my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); for my $line (@lines) { $line = sprintf $line, $server->url; $s->cmd($line); }; $s->cmd('eval $self->agent->uri'); my $code_output = $_STDOUT_; diag join( "\n", $s->history ) unless is($s->agent->uri,$result_location,"Shell moved to the specified url for $name"); is($_STDERR_,undef,"Shell produced no error output for $name"); is($actual_requests,$requests,"$requests requests were made for $name"); my $code_requests = $server->get_output; my $script_server = Test::HTTP::LocalServer->spawn(html => $HTML); my $script_port = $script_server->port; # Modify the generated Perl script to match the new? port my $script = join "\n", $s->script; s!\b$code_port\b!$script_port!smg for ($script, $code_output); undef $s; # Write the generated Perl script my ($fh,$tempname) = tempfile(); print $fh $script; close $fh; my ($compile) = `$^X -c "$tempname" 2>&1`; chomp $compile; unless (is($compile,"$tempname syntax OK","$name compiles")) { $script_server->stop; diag $script; ok(0, "Script $name didn't compile" ); ok(0, "Script $name didn't compile" ); } else { my ($output); my $command = qq($^X -Ilib "$tempname" 2>&1); $output = `$command`; is( $output, $code_output, "Output of $name is identical" ) or diag "Script:\n$script"; my $script_requests = $script_server->get_output; $code_requests =~ s!\b$code_port\b!$script_port!smg; is($code_requests,$script_requests,"$name produces identical queries"); }; unlink $tempname or diag "Couldn't remove tempfile '$name' : $!"; }; unlink $_ for (<*.save_log_server_test.tmp>); }; __DATA__ - Gift Cards

 

Gift Card

Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. Duis autem vel eum iriure dolor in hendrerit in vulputate velit esse molestie consequat, vel illum dolore eu feugiat nulla facilisis at vero eros et accumsan et iusto odio dignissim qui blandit praesent luptatum zzril delenit augue duis dolore te feugait nulla facilisi. Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat.


Delivery Information
recipient Name:
First: *
Middle:
Last: *
Nickname:
Room Number:
Card Amount:
* (i.e. $20.00)
Billing Information
First Name: *
Last Name: *
Email Address : *#
Address: *
City: *
State: *
Zip: *
Country: *
Daytime Phone: *
(i.e. (123)555-1212)
Card Type: *
Name on Card: *
Credit Card Number : *
(no spaces or dashes) i.e.1234567890121234 (use Visa and 4111111111111111 for testing)
Expiration Date: (in format: MM/YY)  *

Your credit information will be sent through a secure and encrypted channel. After submit has been selected, order cannot be changed or cancelled.

 

# Your e-mail address will be used only for receipt purposes and to contact you if there is a problem with your order and we cannot reach you by phone.