#! /usr/bin/perl -w
use strict;
require LWP::UserAgent;
require HTTP::Request;
use Getopt::Std;

my %opts = ();
getopts('h:p:', \%opts);

unless (exists $opts{'h'} && exists $opts{'p'}) {
	die "usage: -h host -p port";
}

my $host = $opts{h};
my $port = $opts{p};

#----------------------------------------

my @companies = ('TECD', 'CRAY', 'IDCP.OB', 'BND', 'MIPS', 'DNTK.OB',
	'WFRCE.OB', 'SCPI.OB', 'HAND', 'EMCC.OB');

my $create_acct = <<EOF;
acct00, Account00, false, 1000000, TECD, 100000
acct01, Account01, false, 1000000, CRAY, 100000
acct02, Account02, false, 1000000, IDCP.OB, 100000
acct03, Account03, false, 1000000, BND, 100000
acct04, Account04, false, 1000000, MIPS, 100000
acct05, Account05, false, 1000000, DNTK.OB, 100000
acct06, Account06, false, 1000000, WFRCE.OB, 100000
acct07, Account07, false, 1000000, SCPI.OB, 100000
acct08, Account08, false, 1000000, HAND, 100000
acct09, Account09, false, 1000000, EMCC.OB, 100000
EOF
$create_acct =~ s/\n/\r\n/sg;

my $do_trades = <<EOF;
/robots/entry?ticker=BND&userid=acct09&type=buy&quantity=7&price=1.65
/robots/entry?ticker=HAND&userid=acct08&type=sell&quantity=5&price=11.74
/robots/entry?ticker=MIPS&userid=acct04&type=sell&quantity=7&price=25.40
/robots/entry?ticker=IDCP.OB&userid=acct02&type=sell&quantity=2
/robots/entry?ticker=EMCC.OB&userid=acct09&type=sell&quantity=1&price=1.04
/robots/entry?ticker=WFRCE.OB&userid=acct06&type=sell&quantity=2&price=1.05
/robots/entry?ticker=BND&userid=acct03&type=sell&quantity=10&price=1.55
/robots/entry?ticker=WFRCE.OB&userid=acct06&type=sell&quantity=2&price=1.07
/robots/entry?ticker=IDCP.OB&userid=acct02&type=sell&quantity=1&price=0.17
/robots/entry?ticker=SCPI.OB&userid=acct07&type=sell&quantity=2&price=0.14
/robots/entry?ticker=DNTK.OB&userid=acct05&type=buy&quantity=1&price=1.47
/robots/entry?ticker=IDCP.OB&userid=acct03&type=buy&quantity=1&price=0.17
/robots/entry?ticker=DNTK.OB&userid=acct05&type=sell&quantity=1&price=1.49
/robots/entry?ticker=IDCP.OB&userid=acct02&type=sell&quantity=7&price=0.17
/robots/entry?ticker=WFRCE.OB&userid=acct08&type=buy&quantity=3&price=1.15
/robots/entry?ticker=MIPS&userid=acct01&type=buy&quantity=2
/robots/entry?ticker=SUNW&userid=acct06&type=buy&quantity=7&price=17.91
/robots/entry?ticker=FWRX.OB&userid=acct07&type=buy&quantity=1&price=0.83
/robots/entry?ticker=DNTK.OB&userid=acct04&type=buy&quantity=7&price=1.51
/robots/entry?ticker=MUEI&userid=acct05&type=buy&quantity=7&price=2.02
/robots/entry?ticker=BADTICKER&userid=acct05&type=buy&quantity=7&price=2.02
EOF
$do_trades =~ s/\n/\r\n/sg;

my $ua = LWP::UserAgent->new;

sub print_response {
	my ($response, $lines) = @_;
	my $r = $response->content;
	$r =~ s/\r\n/|/g;
	$r =~ s/\r/<CR>/g;
	$r =~ s/\n/<LF>/g;
	print substr($r, 0, $lines*80-10), "\n";
	#my @response = split /\r?\n/ , $response->content;
	#for(my $i=0; $i<$lines && $i<=$#response; $i++) {
	#	print $response[$i], "|";
	#}
	#print "\n";
}

#
# fetch the home page
#
my $t1 = time;
my $request = HTTP::Request->new(GET => "http://$host:$port/");
my $response = $ua->request($request);
print "HOME: ", $response->code, " ", $response->message, "\n";
printf "Took %.3fs\n", (time-$t1);
print_response($response, 5);

# 
# /robots/init request
#
$t1 = time;
$request = HTTP::Request->new(POST => "http://$host:$port/robots/init",
	new HTTP::Headers(), $create_acct);
$response = $ua->request($request);
print "\nRobots INIT: ", $response->code, " ", $response->message, "\n";
printf "Took %.3fs\n", (time-$t1);
if ($response->content !~ m|OK|) {
	print "ERROR: INIT did not return \"OK\"!\n";
	print_response($response, 5);
	print "====================\n";
}

#
# /robots/accounts request
#

$t1 = time;
$request = HTTP::Request->new(GET => "http://$host:$port/robots/accounts");
$response = $ua->request($request);
print "\nRobots ACCOUNTS: ", $response->code, " ", $response->message, "\n";
printf "Took %.3fs\n", (time-$t1);
unless ($response->content =~ m!acct00,.*1000000!
&&      $response->content =~ m!acct08,.*1000000!) {
	print "ERROR: ACCOUNTS not created\n";
	print_response($response, 20);
	print "====================\n";
}

# 
# trades
#
$t1 = time;
my $n = 1;
print "\n";
foreach my $url (split '\n', $do_trades) {
	$request = HTTP::Request->new(GET => "http://$host:$port$url");
	$response = $ua->request($request);
	print "Trade $n: ", $response->code, " ", $response->message;
	if ($response->content =~ m!^\r?\n?OK\s+(\d+)\r?\n\Z!) {
		print " order id $1\n";
	} elsif ($response->content =~ m!^\r?\n?ERROR\r?\n(\S.+)\r?\n!) {
		print " rejected: $1\nURL: $url\n";
		print "[Trade correctly rejected.]\n" if $n == 21;
	} else {
		print " ERROR: did not get correct OK/ERROR response\n";
		print_response($response, 10);
		print "====================\n";
	}
	$n++;
}
printf "Took %.3fs\n", (time-$t1);

# 
# /robots/orders request
#
$t1 = time;
$request = HTTP::Request->new(GET => "http://$host:$port/robots/orders");
$response = $ua->request($request);
print "\nOrder book: ", $response->code, " ", $response->message, "\n";
printf "Took %.3fs\n", (time-$t1);
my $resp = $response->content;
$resp =~ s/^[\r\n\t\s]*//g;
$resp =~ s/[\r\t\s]*\n[\t\s]*/\n/g;
$resp =~ s/[\t\s]*,[\t\s]*/,/g;
if ($resp !~ m!\A((?:
			   \d+,[\w\.]+,[-\d:\.\s]+,          # order id, ticker, date
		       acct\d+,(?:buy|sell),[\d\.]+,     # acct, type, qty
		       (?:[\d\.]+|none|null)             # limit price
			   \n+)+[\n\s]*)                     # end of line
			  !x){
	print "ERROR: Cannot parse response!\n";
	print_response($response, 5);
	print "====================\n";
} elsif (length $1 != length $resp) {
	my $s = substr($resp, length $1);
	$s =~ s/\n/<LF>/g; $s =~ s/ /<SP>/g;
	print "ERROR: Cannot parse response starting at \"",
		substr($s, 0, 40), "\"\n";
	print_response($response, 20);
	print "====================\n";
} else {
	my @resp = split /\r?\n[\t\s]*/, $resp;
	@resp = sort {
			$a =~ /^(\d+)/; my $aa = $1;
			$b =~ /^(\d+)/; my $bb = $1;
			$aa <=> $bb;
		} @resp;
	print join("\n", @resp), "\n";
}

# 
# /robots/transactions request
#
$t1 = time;
foreach my $c (@companies) {
	$request = HTTP::Request->new(GET =>
		"http://$host:$port/robots/transactions?$c");
#		"http://$host:$port/robots/transactions?ticker=$c");
	$response = $ua->request($request);
	print "\nTransactions for $c: ", $response->code, " ",
		$response->message, "\n";
	my $resp = $response->content;
	$resp =~ s/^[\r\n\t\s]*//g;
	$resp =~ s/[\r\t\s]*\n[\t\s]*/\n/g;
	$resp =~ s/[\t\s]*,[\t\s]*/,/g;
	#print "RESP:$resp\n";
	if ($resp =~ m!\A[\n\s]*\Z!) {
		print "No transactions\n";
	} elsif ($resp !~ m!\A((?:
				   \d+,[\w\.]+,[-\d:\.\s]+,             # order id, ticker, date
				   acct\d+,(?:buy|sell),[\d\.]+,        # acct, type, qty
				   (?:[\d\.]+|none|null),               # limit price
				   (?:s|split|f|fulfilled|e|expired),   # status
				   [-\d:\.\s]+,                         # date retired
				   (?:[\d\.]+|none|null),               # price
				   (?:\d+|null|none)                    # parent order id
				   \n+)+[\n\s]*)                        # end of line
				  !ix) {
		print "ERROR: Cannot parse response!\n";
		print_response($response, 8);
		print "====================\n";
	} elsif (length $1 != length $resp) {
		my $s = substr($resp, length $1);
		$s =~ s/\n/<LF>/g; $s =~ s/ /<SP>/g;
		print "ERROR: Cannot parse response starting at \"",
			substr($s, 0, 40), "\"\n";
		print_response($response, 20);
		print "====================\n";
	} else {
		my @resp = split /\r?\n[\t\s]*/, $resp;
		@resp = sort {
				$a =~ /^(\d+)/; my $aa = $1;
				$b =~ /^(\d+)/; my $bb = $1;
				$aa <=> $bb;
			} @resp;
		print join("\n", @resp), "\n";
	}
}
printf "Took %.3fs\n", (time-$t1);

# 
# /robots/quotes request
#
$t1 = time;
print "\n";
foreach my $c (@companies) {
	$request = HTTP::Request->new(GET =>
		"http://$host:$port/robots/quotes?$c");
#		"http://$host:$port/robots/transactions?ticker=$c");
	$response = $ua->request($request);
	print "Quote for $c: ", $response->code, " ", $response->message;
	my $resp = $response->content;
	$resp =~ s/^[\r\n\t\s]*//g;
	$resp =~ s/[\r\t\s]*\n[\t\s]*/\n/g;
	$resp =~ s/[\t\s]*,[\t\s]*/,/g;
	#print "RESP:$resp\n";
	if ($resp !~ m!\A([\w\.]+,[\d\.]+,[\d\.]+,[\d\.]+,[\d\.]+)[\n\s]+\Z!) {
		print "\nERROR: Cannot parse response:\n";
		print_response($response, 2);
		print "====================\n";
	} else {
		print " $1\n";
	}
}
printf "Took %.3fs\n", (time-$t1);


print "\n--- The END ---\n";