File Coverage

blib/lib/Finance/Quote/RBA.pm
Criterion Covered Total %
statement 80 101 79.2
branch 15 28 53.5
condition n/a
subroutine 11 12 91.6
pod 0 3 0.0
total 106 144 73.6


to add so it appears in the TableExtract }{}ig; )}{$1}ig;
line stmt bran cond sub pod time code
1             # Copyright 2007, 2008, 2009, 2010, 2011, 2014, 2015 Kevin Ryde
2              
3             # This file is part of Finance-Quote-Grab.
4             #
5             # Finance-Quote-Grab is free software; you can redistribute it and/or
6             # modify it under the terms of the GNU General Public License as published
7             # by the Free Software Foundation; either version 3, or (at your option) any
8             # later version.
9             #
10             # Finance-Quote-Grab is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License
16             # along with this program. If not, see .
17              
18              
19             package Finance::Quote::RBA;
20 1     1   493 use strict;
  1         1  
  1         30  
21 1     1   3 use Scalar::Util;
  1         2  
  1         42  
22 1     1   481 use Finance::Quote 1.15; # for isoTime()
  1         49607  
  1         38  
23              
24 1     1   7 use vars qw($VERSION %name_to_symbol);
  1         2  
  1         83  
25             $VERSION = 13;
26              
27             # uncomment this to run the ### lines
28             #use Smart::Comments;
29              
30              
31             sub methods {
32 1     1 0 1148 return (rba => \&rba_quotes);
33             }
34             sub labels {
35 2     2 0 927 return (rba => [ qw(date isodate name currency
36             last close
37             method source success errormsg
38              
39             time copyright_url) ]);
40             }
41              
42 1         47 use constant EXCHANGE_RATES_URL =>
43 1     1   4 'http://www.rba.gov.au/statistics/frequency/exchange-rates.html';
  1         1  
44              
45 1         814 use constant COPYRIGHT_URL =>
46 1     1   4 'http://www.rba.gov.au/copyright/index.html';
  1         2  
47              
48             sub rba_quotes {
49 0     0 0 0 my ($fq, @symbol_list) = @_;
50 0 0       0 if (! @symbol_list) { return; }
  0         0  
51              
52 0         0 my $ua = $fq->user_agent;
53 0         0 require HTTP::Request;
54 0         0 my $req = HTTP::Request->new ('GET', EXCHANGE_RATES_URL);
55 0         0 $ua->prepare_request ($req);
56 0         0 $req->accept_decodable; # using decoded_content() below
57 0         0 $req->user_agent (__PACKAGE__."/$VERSION " . $req->user_agent);
58              
59 0         0 my $resp = $ua->request ($req);
60 0         0 my %quotes;
61 0         0 _parse ($fq, $resp, \%quotes, \@symbol_list);
62 0 0       0 return wantarray() ? %quotes : \%quotes;
63             }
64              
65             sub _parse {
66 1     1   5401 my ($fq, $resp, $quotes, $symbol_list) = @_;
67              
68 1         2 foreach my $symbol (@$symbol_list) {
69 3         10 $quotes->{$symbol,'method'} = 'rba';
70 3         5 $quotes->{$symbol,'source'} = __PACKAGE__;
71 3         5 $quotes->{$symbol,'success'} = 0;
72             }
73              
74 1 50       4 if (! $resp->is_success) {
75 0         0 _errormsg ($quotes, $symbol_list, $resp->status_line);
76 0         0 return;
77             }
78 1         17 my $content = $resp->decoded_content (raise_error => 1, charset => 'none');
79              
80             # mung
USD
81 1         126 $content =~ s{
82 1         16 $content =~ s{(
$2
83              
84 1         608 require HTML::TableExtract;
85 1         10804 my $te = HTML::TableExtract->new
86             (headers => ['Units of foreign currency per'],
87             slice_columns => 0);
88 1         193 $te->parse($content);
89 1         2177 my $ts = $te->first_table_found;
90 1 50       11 if (! $ts) {
91 0         0 _errormsg ($quotes, $symbol_list, 'rates table not found in HTML');
92 0         0 return;
93             }
94              
95             # column of letters "P" "U" "B" "L" "I" "C" "H" "O" "L" "I" "D" "A" "Y"
96             # on a bank holiday -- skip those
97 1         2 my ($col, $prevcol);
98 1         4 for (my $i = $ts->columns - 1; $i >= 2; $i--) {
99 1 50       182 if (Scalar::Util::looks_like_number ($ts->cell (1, $i))) {
100 1         46 $col = $i;
101 1         2 last;
102             }
103             }
104 1         3 for (my $i = $col - 1; $i >= 2; $i--) {
105 1 50       3 if (Scalar::Util::looks_like_number ($ts->cell (1, $i))) {
106 1         41 $prevcol = $i;
107 1         1 last;
108             }
109             }
110             ### $col
111             ### $prevcol
112 1 50       2 if (! defined $col) {
113 0         0 _errormsg ($quotes, $symbol_list, 'No numeric columns found');
114 0         0 return;
115             }
116              
117 1         2 my $date = $ts->cell (0, $col);
118              
119 1         38 my %want_symbol;
120 1         15 @want_symbol{@$symbol_list} = (); # hash slice
121 1         2 my %seen_symbol;
122              
123 1         2 foreach my $row (@{$ts->rows()}) {
  1         2  
124             ### $row
125              
126 4         114 my $symbol = $row->[0];
127 4 100       7 $symbol or next; # dates row, or no id="" in
128 3         25 $symbol =~ s/_.*//; # _4pm on TWI
129 3         4 $symbol = "AUD$symbol";
130 3 50       6 if (! exists $want_symbol{$symbol}) { next; } # unwanted row
  0         0  
131              
132 3         4 my $name = $row->[1];
133 3 50       4 defined $name or next; # dates row
134 3         8 ($name, my $time) = _name_extract_time ($fq, $name);
135              
136 3         28 my $rate = $row->[$col];
137 3         3 my $prev = $row->[$prevcol];
138              
139 3         13 $fq->store_date($quotes, $symbol, {eurodate => $date});
140 3 50       221 if (defined $time) {
141 3         6 $quotes->{$symbol,'time'} = $time;
142             }
143 3         5 $quotes->{$symbol,'name'} = $name;
144 3         5 $quotes->{$symbol,'last'} = $rate;
145 3         4 $quotes->{$symbol,'close'} = $prev;
146 3 50       6 if ($symbol ne 'TWI') {
147 3         14 $quotes->{$symbol,'currency'} = $symbol;
148             }
149 3         6 $quotes->{$symbol,'copyright_url'} = COPYRIGHT_URL;
150 3         5 $quotes->{$symbol,'success'} = 1;
151              
152             # don't delete AUDTWI from %want_symbol since want to get the last row
153             # which is 16:00 instead of the 9:00 one
154 3         6 $seen_symbol{$symbol} = 1;
155             }
156              
157              
158 1         5 delete @want_symbol{keys %seen_symbol}; # hash slice
159             # any not seen
160 1         4 _errormsg ($quotes, [keys %want_symbol], 'No such symbol');
161             }
162              
163             sub _errormsg {
164 1     1   2 my ($quotes, $symbol_list, $errormsg) = @_;
165 1         45 foreach my $symbol (@$symbol_list) {
166 0         0 $quotes->{$symbol,'errormsg'} = $errormsg;
167             }
168             }
169              
170             # pick out name and time from forms like
171             # Trade-weighted index (9am)
172             # Trade-weighted index (Noon)
173             # Trade-weighted index (4pm)
174             # or without a time is 4pm, like
175             # UK pound sterling
176             #
177             sub _name_extract_time {
178 11     11   4356 my ($fq, $name) = @_;
179              
180 11 100       102 if ($name =~ m/(.*?) +\(Noon\)$/i) { # Noon
    100          
181 2         6 return ($1, '12:00');
182             } elsif ($name =~ m/(.*?) +\(([0-9]+)([ap]m)\)$/i) { # 9am, 4pm
183 7         27 return ($1, $fq->isoTime("$2:00$3"));
184             } else {
185 2         6 return ($name, '16:00'); # default 4pm
186             }
187             }
188              
189             1;
190             __END__