#!/local/bin/perl 

# This is a simple command line UA that can run several requests in
# parallel.  You can control degree of pipelining and set debugging
# flags too.

use strict;
use LWP::UA;
use LWP::Dump;
use LWP::MainLoop qw(empty one_event readable);

use LWP::Request;
use LWP::Conn::HTTP;

$LWP::UA::DEBUG++;
$LWP::Server::DEBUG++;

{ package MyUA;
    use base 'LWP::UA';

    sub response_received
    {
	my($self, $res) = @_;
	print $res->as_string;
    }
}

{ package MyRequest;
    use base 'LWP::Request';

    sub new2
    {
	my $class = shift;
	my $self = $class->SUPER::new2(@_);
	#$self->header("Connection" => "close");
	#$self->protocol("HTTP/1.0");
	$self;
    }

    sub login
    {
	my($self, $realm, $url, $proxy) = @_;
	print "Please enter authentication info for $realm at $url\n";
	my $uname =  main::prompt("Username: ");
	return unless length $uname;
	my $passwd = main::prompt("Passwd:   ");
	return ($uname, $passwd);
    }
}


$| = 1;

my $ua = MyUA->new;
$ua->env_proxy;
$ua->uri_attr_update("SCHEME", "http:")->
    {default_headers}{From} = 'libwww-perl@ics.uci.edu';
$ua->uri_attr_update("SCHEME", "ftp:")-> {max_conn_per_server} = 1;


print "ua> ";
readable(\*STDIN, \&cmd);

while (!empty) {
    one_event();
}
exit;

sub cmd
{
    my $cmd;
    my $n = sysread(STDIN, $cmd, 512);
    chomp($cmd);
    eval {
	if ($cmd eq "q") {
	    exit;
	} elsif ($cmd eq "Q") {
	    my $ans = lc(prompt("really quit? "));
	    exit if $ans eq "y" or $ans eq "yes";
	} elsif ($cmd eq "p") {
	    print $ua->as_string;
	} elsif ($cmd eq "dc") {
	    $LWP::Conn::HTTP::DEBUG = !$LWP::Conn::HTTP::DEBUG;
	    print "Connection debug is ",
	          ($LWP::Conn::HTTP::DEBUG ? "on" : "off"), "\n";
	} elsif ($cmd eq "de") {
	    $LWP::EventLoop::DEBUG = !$LWP::EventLoop::DEBUG;
	    print "Eventlopp debug is ",
	          ($LWP::EventLoop::DEBUG ? "on" : "off"), "\n";
	} elsif ($cmd eq "sched") {
	    $ua->reschedule;
	} elsif ($cmd =~ /^c\s+(\S+)/) {
	    $ua->find_server($1)->create_connection;
	} elsif ($cmd =~ /^cp\s+(.*)/) {
	    $ua->conn_param(split(' ', $1));
	} elsif ($cmd eq "s") {
	    $ua->stop;
	} elsif ($cmd =~ /^s\s+(\S+)/) {
	    $ua->find_server($1)->stop;
	} elsif ($cmd =~ /^\s*(\d*)\s*(\w+)\s+(\S+)\s*$/) {
	    my $count = $1 || 1;
	    my $method = uc($2);
	    my $url = $3;
	    $ua->spool(map MyRequest->new2($method, $url), 1..$count);
        } elsif ($cmd =~ /^\s*!\s*(.*)/) {
	    my $ret = eval $1;
	    if ($@) {
		print $@;
	    } else {
		eval {
		    require Data::Dumper;
		    local $Data::Dumper::Terse;
		    local $Data::Dumper::Indent;
		    $Data::Dumper::Terse = 1;
		    $Data::Dumper::Indent = 0;
		    print Data::Dumper::Dumper($ret), "\n";
		};
		print $@ if $@;
	    }
        } elsif ($cmd eq "?" || $cmd eq "help") {
            print <<EOT;
<method> <url> : spool request
s              : stop all requests
s <url>        : stop requests for this server
p              : print state of UA
c <url>        : set up connection to this host
sched          : invoke scheduler manually
cp <key> <val> : set connection parameters
q              : quit

de             : toggle event loop debugging
dc             : toggle connection debugging
!<perl-code>   : evaluate some perl code (and print result)
EOT
        } elsif ($cmd =~ /^\s*$/) {
	    # ignore
	} else {
	    print "Unknown command '$cmd'.  The command '?' list known commands\n";
	}
    };
    print STDERR $@ if $@;
    print "ua> ";
}


sub prompt
{
    my $p = shift;
    print $p;
    my $buf;
    my $done;
    readable(\*STDIN,
	     sub {
		 my $n = sysread(STDIN, $buf, 512);
		 chomp($buf);
		 $done++;
	     });
    while (!empty && !$done) {
	one_event;
    }
    readable(\*STDIN, \&cmd);
    $buf;
}