#!/usr/bin/perl -w
use strict;
use lib './inc';
use IO::Catch;
use File::Temp qw( tempfile );
use WWW::Mechanize::Link;
# pre-5.8.0's warns aren't caught by a tied STDERR.
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
use vars qw( %tests );
BEGIN {
# Disable all ReadLine functionality
$ENV{PERL_RL} = 0;
%tests = (
'autofill' => 'autofill test Fixed value',
'back' => 'back',
'click' => 'click',
'content' => 'content',
'eval' => 'eval 1',
'fillout' => 'fillout',
'form' => 'form 1',
'form' => 'form test',
'get @' => 'get http://admin@www.google.com/',
'get plain' => 'get http://www.google.com/',
'open' => 'open "foo link"',
'reload' => 'reload',
'referer' => 'referer ""',
'referrer' => 'referrer ""',
'save' => 'save /.../',
'submit' => 'submit',
'value' => 'value key value',
'ua' => 'ua foo/1.0',
'tick' => 'tick key value',
'tick_all' => 'tick key',
'timeout' => 'timeout 60',
'untick' => 'untick key value',
'untick_all' => 'untick key',
);
eval {
require HTML::TableExtract;
$tests{table} = 'table';
$tests{table params} = 'table foo bar';
;
};
};
use Test::More tests => scalar (keys %tests) +1;
SKIP: {
eval {
require Test::MockObject;
Test::MockObject->import();
};
skip "Test::MockObject not installed", scalar keys(%tests) +1
if $@;
my $mock_result = Test::MockObject->new;
$mock_result->set_always( code => 200 );
my $mock_form = Test::MockObject->new;
$mock_form->mock( value => sub {} )
->set_list( inputs => ())
->set_list( find_input => ())
->mock( dump => sub {} )
->set_always( form_name => 'foo' );
my $mock_uri = Test::MockObject->new;
$mock_uri->set_always( abs => 'http://example.com/' )
->set_always( path => '/' );
$mock_uri->fake_module( 'URI::URL', new => sub {$mock_uri} );
my $mock_agent = Test::MockObject->new;
$mock_agent->set_true($_)
for qw( back content get mirror open follow );
$mock_agent->set_false($_)
for qw( form forms );
$mock_agent->set_always( res => $mock_result )
->set_always( add_header => 1 )
->set_always( submit => $mock_result )
->set_always( click => $mock_result )
->set_always( reload => $mock_result )
->set_always( current_form => $mock_form )
->set_always( form_name => 'test form name' )
->set_always( follow_link => 1 )
->set_list( links => WWW::Mechanize::Link->new('foo','foo link','foo_link',""),
WWW::Mechanize::Link->new('foo2','foo2 link','foo2_link',""))
->set_always( agent => 'mocked/1.0')
->set_always( uri => $mock_uri )
->set_always( request => $mock_result )
->set_always( tick => 1 )
->set_always( timeout => 1 )
->set_always( untick => 1 )
;
use_ok('WWW::Mechanize::Shell');
my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef, watchfiles => undef );
$s->{agent} = $mock_agent;
my @history;
{ no warnings 'redefine','once';
*WWW::Mechanize::Shell::add_history = sub {
my $shell = shift;
push @history, $shell->line;
};
};
sub exactly_one_line {
my ($command,$testname) = @_;
$testname ||= $command;
@history = ();
$s->cmd($command);
is_deeply([@history],[$command],"$testname adds one line to history");
};
foreach my $name (sort keys %tests) {
exactly_one_line( $tests{$name},$name );
};
};