#!/usr/bin/perl -w use strict; use lib 'inc'; use IO::Catch; # 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 { %tests = ( back => { count => 3, commands => ['get %s','click submit','back']}, browse => { count => 2, commands => [ 'get %s', 'browse' ] }, get => { count => 1, commands => ['get %s']} , open => { count => 2, commands => ['get %s','open 1'] }, submit => { count => 2, commands => ['get %s','submit']}, click => { count => 2, commands => ['get %s','click submit']}, reload => { count => 2, commands => ['get %s','reload'] }, ) }; use Test::More tests => scalar (keys %tests) +1; SKIP: { BEGIN { # Disable all ReadLine functionality $ENV{PERL_RL} = 0; use_ok('WWW::Mechanize::Shell'); eval { require HTTP::Daemon; }; skip "HTTP::Daemon required to test browser synchronisation",(scalar keys %tests)*6 if ($@); use lib 'inc'; require Test::HTTP::LocalServer; # from inc delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)}; }; my $browser_synced; { no warnings 'redefine'; *WWW::Mechanize::Shell::sync_browser = sub { $browser_synced++; }; }; sub sync_ok { my %args = @_; my $name = $args{name}; my $count = $args{count}; my (@commands) = @{$args{commands}}; my $server = Test::HTTP::LocalServer->spawn(); my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef ); $s->option('autosync', 1); $browser_synced = 0; for my $cmd (@commands) { $cmd = sprintf $cmd, $server->url; $s->cmd($cmd); }; is($browser_synced,$count,"'$name' synchronizes $count times") or diag join "\n", @commands; $server->stop; }; for my $cmd (sort keys %tests) { sync_ok( name => $cmd, %{$tests{$cmd}} ); }; };