1#!/usr/bin/perl -w
2use strict;
3use FindBin;
4
5use lib './inc';
6use IO::Catch;
7our ( $_STDOUT_, $_STDERR_ );
8use URI;
9use Test::HTTP::LocalServer;
10
11# pre-5.8.0's warns aren't caught by a tied STDERR.
12tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;
13
14# Disable all ReadLine functionality
15$ENV{PERL_RL} = 0;
16
17use Test::More tests => 4;
18
19use WWW::Mechanize::Shell;
20
21my $server = Test::HTTP::LocalServer->spawn();
22
23my $user = 'foo';
24my $pass = 'bar';
25
26my $url = URI->new( $server->basic_auth($user => $pass));
27my $host = $url->host;
28
29my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );
30
31# Try without credentials:
32my $bare_url = $url;
33diag "get $bare_url";
34$s->cmd( "get $bare_url" );
35
36my $code = $s->agent->response->code;
37my $got_url = $s->agent->uri;
38
39if (! is $code, 401, "Request without credentials gives 401") {
40    diag "Page location : " . $s->agent->uri;
41};
42
43# Now try the shell command for authentication with bad credentials
44$s->cmd( "auth x$user x$pass" );
45$bare_url = $url;
46diag "get $bare_url";
47eval {
48    $s->cmd( "get $bare_url" );
49};
50is $s->agent->res->code, 401, "Wrong password still results in a 401";
51like $@, qr/Auth Required/, "We die because of that";
52
53# Now try the shell command for authentication with correct credentials
54$s->cmd( "auth $user $pass" );
55$s->cmd( "get $bare_url" );
56is $s->agent->res->code, 200, "Right password results in 200";
57
58#diag "Shutting down test server at $url";
59$server->stop;
60
61