The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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 );
};
};