#!/usr/bin/perl -Tw
#!c:\perl\bin\perl.exe -Tw

# 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 CGI;
use CGI::Carp qw(fatalsToBrowser);
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 $q = shift;
    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;

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

# No trade date means invalid ticker.
	    if ($fields[2] eq "N/A") {
		print $q->p, "No such ticker '$fields[0]'";
	    }
	    else {
		my $change = sprintf "%.2f", 
		    (0 + $fields[4]) / ($fields[1] - (0 + $fields[4])) * 100;

		$tablestr .=
		    $q->Tr({-align => 'center'}, 
			$q->td([ 
			    $fields[0], 
			    $fields[1], 
			    "$fields[2] $fields[3]",
			    "$fields[4] ($change%)", 
			    $fields[5], 
			    "$fields[7] - $fields[6]", 
			    $fields[8] 
			]));

# 		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
	    }
	}

	if ($tablestr) {
	    print $q->table({-border => 1},
		$q->Tr({-align => 'center'}, 
		    $q->th([
			'Ticker', 
			'Last', 
			'Last date/time',
			'Change', 
			'Open', 
			'Day Range', 
			'Volume'
		    ])), 
		$tablestr);
	}
    }

    $sock->close;

} #getquote

sub showform {
    my $q = shift;

    print $q->startform(-method => 'GET');

    print $q->textfield(-name => 'tickers', -size => 40, -maxlength => 40);
    print $q->submit(-name => 'Get Quotes');

    print $q->endform;
}

# main

my $q = new CGI;

print $q->header;
print $q->start_html(-title => 'Stock Quotes');

if ($q->param('tickers')) {
    my @tickers = split ' ', $q->param('tickers');
    init;
    getquote $q, @tickers;
}
else {
    showform $q;
}

print $q->end_html;

# The End.