#!/usr/bin/perl 

# Perl 5.x script for querying the Yahoo! quote server.
# by Po Shan Cheah (cheah@nic.com)
# Check http://www.nic.com/~cheah/quote.html for updates

require 5.004;
use strict;

use Socket;
use FileHandle;
use Getopt::Std;

my $SERVER = 'quote.yahoo.com';
#my $SERVER = '204.71.200.43';
my $PORT = 80;
my $TIMEOUT = 15;

my $raw = 0;

my $ipaddr;
my $proto;

# Perform name and protocol resolution
sub init {
    my @hostinfo;
    my @protoinfo;

    @hostinfo = gethostbyname($SERVER) or die "gethostbyname error: $!\n";
    @protoinfo = getprotobyname('tcp') or die "getprotobyname error: $!\n";

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

# Trim trailing whitespace on each line.
# Discard HTTP result header returned by server.
sub get_result {
    my $inbody = 0;
    my @results;

    for (@_) {
	chomp;
	s/\s+$//;

	if ($inbody) {
	    push @results, $_;
	    next;
	}

	if (/^$/) {
	    $inbody = 1;
	    next;
	}
    }

    @results;

} #get_result

# Parse comma-delimited text.
# From Mastering Regular Expressions, Jeffrey Friedl.
sub parse_csv {
    my $text = shift;
    my @fields = ();

    while ($text =~ m/"([^"\\]*(\\.[^"\\]*)*)",?|([^,]+),?|,/g) {
	push(@fields, defined($1) ? $1 : $3);  #add the just-matched field
    }
    push(@fields, undef) if $text =~ m/,$/; #account for an empty last field

    @fields;
} #parse_csv

# Perform one query for all the securities.
sub getquote {
    my @securities = @_;
    my @text;

#     local $SIG{ALRM} = sub { close SOCK; goto RETRY; };

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

# Convert numeric IP address to string.
    my $ipstr = join('.', map { ord($_) } split('', $ipaddr));

#  RETRY:

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

#    alarm $TIMEOUT;

    print "Connecting to $SERVER ($ipstr) port $PORT...\n";

    my $sock = new FileHandle;

# Connect to quote server.
    socket $sock, PF_INET, SOCK_STREAM, $proto or die "socket error: $!\n";
    connect $sock, $there or die "connect error: $!\n";

# no buffering
    $sock->autoflush(1);

    print "Connected.\n";

# Format and send the query
    my $query = "/d/quotes.csv?s=" . join('+', @securities) . 
	"&f=sl1d1t1c1ohgv&e=.csv";

# print "Query is $query\n";
    
    print $sock <<EOM;
GET $query HTTP/1.1
Host: quote.yahoo.com
Accept: */*
User-Agent: quote2.pl

EOM

# get response from quote server

    @text = <$sock>;

#     alarm 0;

    if ($raw) {
# Dump output without processing. For debugging only.
	print @text;
    }

    else {

# Trim trailing whitespace on each line.
# Discard HTTP result header returned by server.

	@text = get_result @text;
	
	for (@text) {
	    my @fields = parse_csv $_;

# No trade date means invalid ticker.
	    if ($fields[2] eq "N/A") {
		print <<EOM
No such ticker '$fields[0]'.

EOM
	    }
	    else {
		my $change = sprintf "%.2f", 
		    (0 + $fields[4]) / ($fields[1] - (0 + $fields[4])) * 100;

		print <<EOM;
Ticker:        $fields[0]
Last trade:    $fields[1]
Last trade at: $fields[2] $fields[3]
Change:        $fields[4] ($change%)
Opened at:     $fields[5]
Day range:     $fields[7] - $fields[6]
Volume:        $fields[8]

EOM
	    }
	}
    }

    $sock->close;

} #getquote

# main

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

my $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

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

die "$USAGE" if $::opt_h;

$raw = $::opt_r;

# Process command line options.
$::opt_s and $SERVER = $::opt_s;
$::opt_p and $PORT = $::opt_p;
$::opt_t and $TIMEOUT = $::opt_t;

@ARGV > 0 or die "$USAGE";

init;
getquote @ARGV;

# The End.