Finance::QuoteHist::Yahoo - Site-specific subclass for retrieving historical stock quotes.

  use Finance::QuoteHist::Yahoo;
  $q = new Finance::QuoteHist::Yahoo
     (
      symbols    => [qw(IBM UPS AMZN)],
      start_date => '01/01/2009',
      end_date   => 'today',
     );

  # Values
  foreach $row ($q->quotes()) {
    ($symbol, $date, $open, $high, $low, $close, $volume) = @$row;
    ...
  }

  # Splits
  foreach $row ($q->splits()) {
     ($symbol, $date, $post, $pre) = @$row;
  }

  # Dividends
  foreach $row ($q->dividends()) {
     ($symbol, $date, $dividend) = @$row;
  }

  http://docs.yahoo.com/info/terms/

package Finance::QuoteHist::Yahoo;

use strict;
use vars qw(@ISA $VERSION);
use Carp;

$VERSION = '1.05';

use Finance::QuoteHist::Generic;
@ISA = qw(Finance::QuoteHist::Generic);

use HTML::TableExtract 2.07;
use Date::Manip;
Date::Manip::Date_Init("TZ=GMT");

# Example for HTML output:
#
# http://finance.yahoo.com/q/hp?s=IBM&a=00&b=2&c=1800&d=04&e=8&f=2005&g=d&z=66&y=66
#
#   * s - ticker symbol
#   * a - start month
#   * b - start day
#   * c - start year
#   * d - end month
#   * e - end day
#   * f - end year
#   * g - resolution (e.g. 'd' is daily, 'w' is weekly, 'm' is monthly)
#   * y is the offset (cursor) from the start date
#   * z is the number of results to return starting at the cursor (66
#     maximum, apparently)
#
# Note alternate url:
# http://table.finance.yahoo.com/d?a=1&b=1&c=1800&d=3&e=1&f=2006&s=yhoo&y=200&g=d
#
# Example for CSV output:
#
# http://ichart.finance.yahoo.com/table.csv?s=IBM&a=00&b=2&c=1800&d=04&e=8&f=2005&g=d&ignore=.csv
#
# (historically could use table.finance.yahoo.com as well)
#
# Note that Yahoo implements month numbering with Jan=0 and Dec=11.
#
# For CSV output, date ranges are unlimited; the output is adjusted and
# does not include any split or dividend notices.
#
# URL for splits and dividends:
#
# These are either extracted from within the historical quote results
# (non_quote_row()) or found directly:
#
# http://finance.yahoo.com/q/hp?s=IBM&a=00&b=2&c=1800&d=04&e=8&f=2005&g=v
# http://table.finance.yahoo.com/table.csv?s=IBM&a=00&b=2&c=1800&d=04&e=8&f=2005&g=v&ignore=.csv
#
# Example URL for weekly:
#
# http://finance.yahoo.com/q/hp?s=IBM&a=00&b=2&c=1962&d=01&e=27&f=2006&g=w
#
# Example URL for monthly:
#
# http://finance.yahoo.com/q/hp?s=IBM&a=00&b=2&c=1962&d=01&e=27&f=2006&g=m

sub new {
  my $that = shift;
  my $class = ref($that) || $that;
  my %parms = @_;

  $parms{parse_mode} ||= 'csv';

  my $self = __PACKAGE__->SUPER::new(%parms);
  bless $self, $class;

  $self->set_label_pattern(
    target_mode => 'dividend',
    parse_mode  => 'html',
    label       => 'div',
    pattern     => qr/(Open|Div)/
  );

  $self;
}

# override these for other Yahoo sites
sub url_base_csv    { 'http://ichart.finance.yahoo.com/table.csv' }
sub url_base_html   { 'http://finance.yahoo.com/q/hp' }
sub url_base_splits { 'http://finance.yahoo.com/q/bc' }

sub granularities { qw( daily weekly monthly ) }

# Yahoo can fetch dividends and splits. They can be extracted from
# regular quote results or queried directly.

sub html_parser {
  my($self, %parms) = @_;
  my $target_mode = $parms{target_mode} || $self->target_mode;
  return $self->SUPER::html_parser(%parms) unless $target_mode eq 'split';
  sub {
    my $data = shift;
    my $html_string;
    if (ref $data) {
      local($/);
      $html_string = <$data>;
    }
    else {
      $html_string = $data;
    }
    my %te_parms = (
      headers => ['Splits:'],
      debug   => $self->{debug},
    );
    my $te = HTML::TableExtract->new(%te_parms);
    $te->parse($html_string);
    my $table = $te->first_table_found || return [];
    my($split_line) = grep(defined && /split/i, $table->hrow);
    $split_line =~ s/^\s*splits:?\s*//i;
    my @rows;
    foreach (grep(/\w+/, split(/\]\s*,\s+/, $split_line))) {
      s/\s+$//;
      next if /none/i;
      next unless s/\s*\[(\d+):(\d+).*$//;
      my($post, $pre) = ($1, $2);
      my $date = ParseDate($_)
        or croak "Problem parsing date string '$_'\n";
      push(@rows, [$date, $post, $pre]);
    }
    \@rows;
  };
}

sub labels {
  my $self = shift;
  my %parms = @_;
  my $target_mode = $self->target_mode;
  my @labels = $self->SUPER::labels(%parms);
  push(@labels, 'adj') if $target_mode eq 'quote';
  @labels;
}

sub extractors {
  # Override. If we are pulling CSV, save some time by skipping
  # extraction attempts
  my $self  = shift;
  my %parms = @_;
  my $target_mode = $parms{target_mode} || $self->target_mode;
  my $parse_mode  = $parms{parse_mode}  || $self->parse_mode;
  return () if $parse_mode eq 'csv';
  return () unless $target_mode eq 'quote' || $target_mode eq 'dividend';
  my $date_column = $self->label_column('date');
  my $split_column = 1;
  my %extractors;
  # for both quote and dividend results in html mode
  $extractors{'split'} = sub {
    my $row = shift;
    die "row as array ref required" unless ref $row;
    # example split: "3 : 1 Stock Split"
    my($post, $pre) = $row->[$split_column] =~ /(\d+)\s*:\s*(\d+).*Split/i;
    return undef unless $post && $pre;
    [ $row->[$date_column], $post, $pre ];
  };
  if ($target_mode eq 'quote') {
    my $div_column = 1;
    $extractors{dividend} = sub {
      # Get a row as array ref, see if it contains dividend info. If so,
      # return another array ref with the extracted info.
      my $row = shift;
      die "row as array ref required\n" unless ref $row;
      # example dividend: "$0.01 Cash Dividend"
      my($div) = $row->[$div_column] =~ /\$*(\d*\.\d+).*Dividend/i;
      return undef unless defined $div;
      [ $row->[$date_column], $row->[$div_column] ];
    };
  }
  %extractors;
}

sub url_maker {
  my($self, %parms) = @_;
  my $target_mode = $parms{target_mode} || $self->target_mode;
  my $parse_mode  = $parms{parse_mode}  || $self->parse_mode;

  # *always* block unknown target mode and parse mode combinations for
  # cascade to work properly!
  return undef unless $target_mode eq 'quote' ||
                      $target_mode eq 'split' ||
                      $target_mode eq 'dividend';
  return undef unless $parse_mode eq 'html' || $parse_mode eq 'csv';

  my $granularity = lc($parms{granularity} || $self->granularity);
  my $grain = 'd';
  $granularity =~ /^\s*(\w)/;
  $grain = $1 if $1 eq 'w' || $1 eq 'm';
  my($ticker, $start_date, $end_date) =
    @parms{qw(symbol start_date end_date)};
  $start_date ||= $self->start_date;
  $end_date   ||= $self->end_date;
  if ($start_date && $end_date && $start_date gt $end_date) {
    ($start_date, $end_date) = ($end_date, $start_date);
  }

  if ($target_mode eq 'split') {
    $self->parse_mode('html');
    my @urls = $self->url_base_splits() . "?s=$ticker&t=my";
    return sub { pop @urls };
  }

  my $base_url = $parse_mode eq 'csv' ? $self->url_base_csv() :
                                        $self->url_base_html();
  my @base_parms;
  if ($start_date) {
    my($y, $m, $d) = $self->ymd($start_date);
    $m = sprintf("%02d", $m - 1);
    push(@base_parms, "a=$m", "b=$d", "c=$y");
  }
  if ($end_date) {
    my($y, $m, $d) = $self->ymd($end_date);
    $m = sprintf("%02d", $m - 1);
    push(@base_parms, "d=$m", "e=$d", "f=$y");
  }
  my $g = $target_mode eq 'quote' ? $grain : 'v';
  $ticker ||= 'BOOLEAN';
  push(@base_parms, "g=$g", "s=$ticker");
  
  if ($parse_mode eq 'html' && $target_mode eq 'quote' || $target_mode eq 'dividend') {
    my $cursor = 0;
    my $window = 66;
    return sub {
      my $url = $base_url . '?' .
        join('&', @base_parms,
                 "z=$window", "y=$cursor");
      $url .= '&ignore=.csv' if $parse_mode eq 'csv';
      $cursor += $window;
      $url;
    }
  }
  else {
    my @urls = $base_url .  '?' . join('&', @base_parms);
    $urls[0] .= '&ignore=.csv' if $parse_mode eq 'csv';
    return sub { pop @urls }
  }
}

1;

__END__