#!/usr/bin/perl

# Perl 5.x script for querying the secapl quote server
# by Po Shan Cheah (cheah@nic.com)
# Check http://www.nic.com/~cheah/quote.html for updates
#
# October 7, 1996:
#   added code for stocks (still messy)
#   added code to tell when the quote server does not
#   recognize a stock symbol
# January 10, 1997:
#   connect retry
#   better stock data formatting
#   command line options for server, port, timeout
#   changed default server
# December 4, 1997:
#   Disabled the alarm calls for Win32.


use strict;

use Socket;
use Getopt::Std;

BEGIN {

    # Uncomment the one you want as the default the two IP addresses
    # are equivalent to the host names as of January 10, 1997. At that
    # time, qs-alt was a little faster than qs.
    
    $::SERVER = 'qs-alt.secapl.com';
    #$::SERVER = 'qs.secapl.com';
    #$::SERVER = '192.131.69.9';
    #$::SERVER = '207.79.173.10';
    
    $::PORT = 80;

    $::TIMEOUT = 15;
    
    $::USAGE = <<"EOM";
Usage: $0 [-s server] [-p port] [-t timeout] symbol [symbol ...]
    -s  Specify server to contact. Default: $::SERVER
    -p  Specify tcp/ip port to contact. Default: $::PORT
    -t  Specify timeout in seconds for connection retries. Default: $::TIMEOUT
EOM

    $::iswin32 = $^O eq "MSWin32";
}

# perform name and protocol resolution

sub init {
    my(@hostinfo, @protoinfo);

    (@hostinfo = gethostbyname($::SERVER)) ||
	die "gethostbyname error: $!\n";

    (@protoinfo = getprotobyname('tcp')) ||
	die "getprotobyname error: $!\n";

    $::ipaddr = $hostinfo[4];
    $::proto = $protoinfo[2];
}

# Format left-aligned, right-aligned, and centered strings.

sub left {
    my($width, $str) = @_;
    my($spaces) = $width - length $str;

    if ($spaces < 0) {
	$spaces = 0;
    }

    $str . " " x $spaces;
}

sub right {
    my($width, $str) = @_;
    my($spaces) = $width - length $str;

    if ($spaces < 0) {
	$spaces = 0;
    }

    " " x $spaces . $str;
}

sub center {
    my($width, $str) = @_;
    my($spaces) = $width - length $str;
    my($leftspaces);

    if ($spaces < 0) {
	$spaces = 0;
    }

    $leftspaces = int($spaces / 2);

    " " x $leftspaces . $str . " " x ($spaces - $leftspaces);
}

# The secapl server returns the stock data in a html <TABLE>. Attempt
# to format the contents of that table.

sub format_stock {
    my(@text) = @_;
    my($stream);
    local($_);
    my($tablemode) = 0;
    my($col) = 0;

    # These arrays are used for formatting the rows in the different
    # <TABLE>s. Each entry describes one column in the table.

    my(@formattable1) = (
			 [ 14, \&left ],
			 [ 10, \&right ],
			 [ 14, \&left ],
			 [ 10, \&right ]
			);

    my(@formattable2) = (
			 [ 14, \&left ],
			 [ 7, \&right ],
			 [ 14, \&left ],
			 [ 7, \&right ],
			 [ 14, \&left ],
			 [ 7, \&right ]
			);

    chomp @text;
    $stream = join('', @text);

    # Add a space to empty <TD> entries so they won't get ignored. 

    $stream =~ s/(<TD[^>]*>)(<\/TD>)/$1 $2/gi;

#    print "$stream\n";

    # Chop off everything except the stuff contained between the first
    # <TABLE> and the last </TABLE>.

    $stream =~ /<TABLE[^>]*>(.*)<\/TABLE>/ig;

    $stream = $1;

    while ($stream =~ /<[^>]*>+([^<]+)/g) {
	$_ = $1;

	# Remove leading, trailing spaces. Squish multiple spaces
	# into one.

	s/^\s+//;
	s/\s+$//;
	s/\s+/ /g;

	# The $tablemode state represents the <TABLE> the script is
	# currently processing. Each <TABLE> has a different number of
	# columns and a different format. $col is the column number
	# starting at 0 for the first column.

    AGAIN:
	if ($tablemode == 0) {

	    if (/last traded/i) {
		$tablemode = 1;
		$col = 0;
		print "\n";
		goto AGAIN;
	    }

	    print center(67, $_), "\n" if $_;

	}

	elsif ($tablemode == 1) {

	    if (/EPS/i) {
		$tablemode = 2;
		$col = 0;
		print "\n";
		goto AGAIN;
	    }

	    print &{$formattable1[$col][1]}($formattable1[$col][0], $_);
	    ++$col;
	    if ($col % 4) {
		print "  ";
	    }
	    else {
		print "\n";
		$col = 0;
	    }
	}

	else {

	    print &{$formattable2[$col][1]}($formattable2[$col][0], $_);
	    ++$col;
	    if ($col % 6) {
		print "  ";
	    }
	    else {
		print "\n";
		$col = 0;
	    }
	}
    }

    print "\n";
}

# Perform a query for one security. Note: because of httpd design and
# this script not taking advantage of persistent connections, each
# query requires a new connection.

sub getquote {
    my $security = shift;
    my(@result, @text);
    my($there, $query, $result);  

    unless ($::iswin32) {
	local $SIG{ALRM} = sub { close SOCK; goto RETRY; };
    }

    # connect to quote server

    $there = pack('Sna4x8', AF_INET, $::PORT, $::ipaddr);

 RETRY:

    # This alarm is for retrying queries that look like they
    # are taking too long.

    unless ($::iswin32) {
        alarm $::TIMEOUT;
    }

    print "Connecting to $::SERVER port $::PORT...\n";

    socket(SOCK, PF_INET, SOCK_STREAM, $::proto) ||
	die "socket error: $!\n";

    connect(SOCK, $there) ||
	die "connect error: $!\n";

    # no buffering

#    select((select(SOCK), $| = 1)[0]);

    select(SOCK);
    $| = 1;
    select(STDOUT);

    print "Connected.\n";

    # form and send the query

    $query = "gif=0&time=${\sprintf('%016d',time)}&tick=$security";
    # print "Query is $query\n";

    print SOCK <<"EOM";
POST /cgi-bin/qs HTTP/1.1
Content-type: text/plain
Content-length: ${\length($query)}
Accept: text/html
User-Agent: quote.pl

$query
EOM

    # get response from quote server

    @text = <SOCK>;

    unless ($::iswin32) {
	alarm 0;
    }

    if ($::raw) {

	# Dump output without processing. For debugging only.

	print @text;
    }

    elsif (@result = grep(/<pre>/ .. /<\/pre>/, @text)) {

	# mutual fund quotes are returned in preformatted blocks. easy.

	pop @result;
	shift @result;
	print @result;
	print "\n";
    }

    elsif (grep(/<table/i, @text)) {

	# If there is a <TABLE>, it is a stock.

	format_stock(@text);
    }

    elsif (grep(/Invalid Symbol for this server./, @text)) {

	print "Symbol `$security' is unknown to the quote server.\n";

    }

    else {
	print "Can't understand HTML output. Displaying it raw:\n";
	print "@text\n";
    }

    close SOCK;
}

# main

$::opt_h = 0;
$::opt_r = 0;

getopts('s:p:t:hr') || die "$::USAGE";

if ($::opt_h) {
    print "$::USAGE";
    exit;
}

$::raw = $::opt_r;

if ($::opt_s) { $::SERVER = $::opt_s; }
if ($::opt_p) { $::PORT = $::opt_p; }
if ($::opt_t) { $::TIMEOUT = $::opt_t; }

@ARGV > 0 || die "$::USAGE";

init();

for (@ARGV) {
    getquote($_);
}

# vim:sw=4