view release on metacpan or  search on metacpan

lib/Finance/Quote/RBA.pm  view on Meta::CPAN

# Copyright 2007, 2008, 2009, 2010, 2011, 2014, 2015, 2016, 2019 Kevin Ryde

# This file is part of Finance-Quote-Grab.
#
# Finance-Quote-Grab is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 3, or (at your option) any
# later version.
#
# Finance-Quote-Grab is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
# or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
# for more details.
#
# You should have received a copy of the GNU General Public License
# along with Finance-Quote-Grab.  If not, see <http://www.gnu.org/licenses/>.


package Finance::Quote::RBA;
use strict;
use Scalar::Util;
use Finance::Quote 1.15; # for isoTime()

use vars qw($VERSION %name_to_symbol);
$VERSION = 15;

# uncomment this to run the ### lines
#use Smart::Comments;


sub methods {
  return (rba => \&rba_quotes);
}
sub labels {
  return (rba => [ qw(date isodate name currency
                      last close
                      method source success errormsg

                      time copyright_url) ]);
}

use constant EXCHANGE_RATES_URL =>
  'https://www.rba.gov.au/statistics/frequency/exchange-rates.html';

use constant COPYRIGHT_URL =>
  'https://www.rba.gov.au/copyright/index.html';

sub rba_quotes {
  my ($fq, @symbol_list) = @_;
  if (! @symbol_list) { return; }

  my $ua = $fq->user_agent;
  require HTTP::Request;
  my $req = HTTP::Request->new ('GET', EXCHANGE_RATES_URL);
  $ua->prepare_request ($req);
  $req->accept_decodable; # using decoded_content() below
  $req->user_agent (__PACKAGE__."/$VERSION " . $req->user_agent);

  my $resp = $ua->request ($req);
  my %quotes;
  _parse ($fq, $resp, \%quotes, \@symbol_list);
  return wantarray() ? %quotes : \%quotes;
}

sub _parse {
  my ($fq, $resp, $quotes, $symbol_list) = @_;

  foreach my $symbol (@$symbol_list) {
    $quotes->{$symbol,'method'}  = 'rba';
    $quotes->{$symbol,'source'}  = __PACKAGE__;
    $quotes->{$symbol,'success'} = 0;
  }

  if (! $resp->is_success) {
    _errormsg ($quotes, $symbol_list, $resp->status_line);
    return;
  }
  my $content = $resp->decoded_content (raise_error => 1, charset => 'none');

  # mung <tr id="USD"> to add <td>USD</td> so it appears in the TableExtract
  $content =~ s{<tr>}{<tr><td></td>}ig;
  $content =~ s{(<tr +id="([^"]*)">)}{$1<td>$2</td>}ig;

  require HTML::TableExtract;
  my $te = HTML::TableExtract->new
    (
     # now in a <caption> instead of a heading
     # headers => [qr/Units of Foreign Currencies per/i],
     slice_columns => 0);
  $te->parse($content);
  my $ts = $te->first_table_found;
  if (! $ts) {
    _errormsg ($quotes, $symbol_list, 'rates table not found in HTML');
    return;
  }

  # column of letters "P" "U" "B" "L" "I" "C" "H" "O" "L" "I" "D" "A" "Y"
  # on a bank holiday -- skip those
  my ($col, $prevcol);
  for (my $i = $ts->columns - 1; $i >= 2; $i--) {
    if (Scalar::Util::looks_like_number ($ts->cell (1, $i))) {
      $col = $i;
      last;
    }
  }
  for (my $i = $col - 1; $i >= 2; $i--) {
    if (Scalar::Util::looks_like_number ($ts->cell (1, $i))) {
      $prevcol = $i;
      last;
    }
  }
  ### $col
  ### $prevcol
  if (! defined $col) {
    _errormsg ($quotes, $symbol_list, 'No numeric columns found');
    return;
  }

  my $date = $ts->cell (0, $col);

  my %want_symbol;
  @want_symbol{@$symbol_list} = (); # hash slice
  my %seen_symbol;

  foreach my $row (@{$ts->rows()}) {
    ### $row

    my $symbol = $row->[0];
    $symbol or next;       # dates row, or no id="" in <tr>
    $symbol =~ s/_.*//; # _4pm on TWI
    $symbol = "AUD$symbol";
    if (! exists $want_symbol{$symbol}) { next; } # unwanted row

    my $name   = $row->[1];
    defined $name or next; # dates row
    ($name, my $time) = _name_extract_time ($fq, $name);

    my $rate = $row->[$col];