Finance::Quote::RBA - download Reserve Bank of Australia currency rates

 use Finance::Quote;
 $q = Finance::Quote->new ('RBA');
 %rates = $q->fetch ('rba', 'AUDGBP', 'AUDUSD');

    AUDUSD    US dollar
    AUDCNY    Chinese renminbi
    AUDJPY    Japanese yen
    AUDEUR    Euro
    AUDKRW    South Korean won
    AUDGBP    British pound sterling
    AUDSGD    Singapore dollar
    AUDINR    Indian rupee
    AUDTHB    Thai baht
    AUDNZD    New Zealand dollar
    AUDTWD    Taiwanese dollar
    AUDMYR    Malaysian ringgit
    AUDIDR    Indonesian rupiah
    AUDVND    Vietnamese dong
    AUDAED    United Arab Emirates dirham
    AUDPGK    Papua New Guinea kina
    AUDHKD    Hong Kong dollar
    AUDCAD    Canadian dollar
    AUDZAR    South African rand
    AUDSAR    Saudi Arabia riyal
    AUDCHF    Swiss franc
    AUDSEK    Swedish krona

    AUDTWI    Trade Weighted Index
    AUDSDR    Special Drawing Right

    date isodate name currency
    last close
    method source success errormsg

    time              ISO string "HH:MM"
    copyright_url

# Copyright 2007, 2008, 2009, 2010, 2011 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 this program.  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 = 9;

# 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 =>
  'http://www.rba.gov.au/statistics/frequency/exchange-rates.html';

use constant COPYRIGHT_URL =>
  'http://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 ("Finance::Quote::RBA/$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
    (headers => ['Units of foreign currency per'],
     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];
    my $prev = $row->[$prevcol];

    $fq->store_date($quotes, $symbol, {eurodate => $date});
    if (defined $time) {
      $quotes->{$symbol,'time'} = $time;
    }
    $quotes->{$symbol,'name'}   = $name;
    $quotes->{$symbol,'last'}   = $rate;
    $quotes->{$symbol,'close'}  = $prev;
    if ($symbol ne 'TWI') {
      $quotes->{$symbol,'currency'} = $symbol;
    }
    $quotes->{$symbol,'copyright_url'} = COPYRIGHT_URL;
    $quotes->{$symbol,'success'}  = 1;

    # don't delete AUDTWI from %want_symbol since want to get the last row
    # which is 16:00 instead of the 9:00 one
    $seen_symbol{$symbol} = 1;
  }


  delete @want_symbol{keys %seen_symbol}; # hash slice
  # any not seen
  _errormsg ($quotes, [keys %want_symbol], 'No such symbol');
}

sub _errormsg {
  my ($quotes, $symbol_list, $errormsg) = @_;
  foreach my $symbol (@$symbol_list) {
    $quotes->{$symbol,'errormsg'} = $errormsg;
  }
}

# pick out name and time from forms like
#     Trade-weighted index (9am)
#     Trade-weighted index (Noon)
#     Trade-weighted index (4pm)
# or without a time is 4pm, like
#     UK pound sterling
#
sub _name_extract_time {
  my ($fq, $name) = @_;

  if ($name =~ m/(.*?) +\(Noon\)$/i) {
    return ($1, '12:00');
  } elsif ($name =~ m/(.*?) +\(([0-9]+)([ap]m)\)$/i) {
    return ($1, $fq->isoTime("$2:00$3"));
  } else {
    return ($name, '16:00');
  }
}

1;
__END__