#!/usr/bin/perl -w
use strict;
use FindBin;

use lib 'inc';
use IO::Catch;
use vars qw( $_STDOUT_ $_STDERR_ );

# pre-5.8.0's warns aren't caught by a tied STDERR.
tie *STDOUT, 'IO::Catch', '_STDOUT_' or die $!;

# Disable all ReadLine functionality
$ENV{PERL_RL} = 0;

use Test::More tests => 6;
SKIP: {

use_ok('WWW::Mechanize::Shell');

eval { require HTTP::Daemon; };
skip "HTTP::Daemon required to test basic authentication",7
  if ($@);

# We want to be safe from non-resolving local host names
delete @ENV{qw(HTTP_PROXY http_proxy CGI_HTTP_PROXY)};

my $user = 'foo';
my $pass = 'bar';

# Now start a fake webserver, fork, and connect to ourselves
open SERVER, qq{"$^X" "$FindBin::Bin/401-server" $user $pass |}
  or die "Couldn't spawn fake server : $!";
sleep 1; # give the child some time
my $url = <SERVER>;
chomp $url;
die "Couldn't decipher host/port from '$url'"
    unless $url =~ m!^http://([^/]+)/!;
my $host = $1;

my $s = WWW::Mechanize::Shell->new( 'test', rcfile => undef, warnings => undef );

# First try with an inline username/password
my $pwd_url = $url;
$pwd_url =~ s!^http://!http://$user:$pass\@!;
$pwd_url .= 'thisshouldpass';
diag "get $pwd_url";
$s->cmd( "get $pwd_url" );
diag $s->agent->res->message
  unless is($s->agent->res->code, 200, "Request with inline credentials gives 200");
is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good");

# Now try without credentials
my $bare_url = $url . "thisshouldfail";
diag "get $bare_url";
$s->cmd( "get $bare_url" );

my $code = $s->agent->response->code;
my $got_url = $s->agent->uri;

if (! ok $code == 401 || $got_url ne $bare_url, "Request without credentials gives 401 (or is hidden by a WWW::Mechanize bug)") {
    diag "Page location : " . $s->agent->uri;
    diag $s->agent->res->as_string;
};

SKIP: {
if ($got_url ne $url) {
    skip "WWW::Mechanize 1.50 has a bug that doesn't give you a 401 page", 1;
} else {
    like($s->agent->content, '/^auth required /', "Content requests authentication")
        or diag $s->agent->res->as_string;
};
};

# Now try the shell command for authentication
$s->cmd( "auth foo bar" );

# WWW::Mechanize breaks the LWP::UserAgent API in a bad, bad way
# it even monkeypatches LWP::UserAgent so we have no better way
# than to hope for the best :-(((

# If it didn't return our expected credentials, we're a victim of
# WWW::Mechanize's monkeypatch :-(
my @credentials = $s->agent->get_basic_credentials();

if ($credentials[0] ne 'foo') {
    SKIP: { 
        skip "WWW::Mechanize $WWW::Mechanize::VERSION has buggy implementation/override of ->credentials", 1;
    };
} else {
    diag "Credentials are @credentials";
    use Data::Dumper;
    my $a = $s->agent;
    @credentials = $a->get_basic_credentials();
    diag "Credentials are @credentials";

    my @real_credentials = LWP::UserAgent::credentials($a,$host,'testing realm');
    SKIP: {
        if ($real_credentials[0] ne $credentials[0]) {
            skip "WWW::Mechanize credentials() patch breaks LWP::UserAgent credentials()", 1;
        } else {
            $s->cmd( "get $url" );
            diag $s->agent->res->message
                unless is($s->agent->res->code, 200, "Request with credentials gives 200");
            is($s->agent->content, "user = 'foo' pass = 'bar'", "Credentials are good");
        };
    };
};

diag "Shutting down test server at $url";
$s->agent->get("${url}exit"); # shut down server

};

END {
  close SERVER; # boom
};