File Coverage

blib/lib/Finance/Quote/MLC.pm
Criterion Covered Total %
statement 14 77 18.1
branch 2 14 14.2
condition n/a
subroutine 4 10 40.0
pod 0 7 0.0
total 20 108 18.5


line stmt bran cond sub pod time code
1             # Copyright 2004, 2005, 2006, 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,
11             # but WITHOUT ANY WARRANTY; without even the implied warranty of
12             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
13             # Public License 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             package Finance::Quote::MLC;
19 1     1   19099 use strict;
  1         2  
  1         33  
20              
21 1     1   3 use vars qw($VERSION);
  1         1  
  1         81  
22             $VERSION = 14;
23              
24             # uncomment this to run the ### lines
25             #use Smart::Comments;
26              
27             sub methods {
28 0     0 0 0 return (mlc => \&mlc_quotes);
29             }
30             sub labels {
31 0     0 0 0 return (mlc => [ qw(date isodate name currency
32             last close
33             method source success errormsg
34              
35             copyright_url
36             ) ]);
37             }
38              
39 1         746 use constant COPYRIGHT_URL =>
40 1     1   4 'http://www.mlc.com.au/mlc/im_considering_mlc/personal/footer_tools/advice_warning_and_disclaimer';
  1         1  
41              
42              
43             sub mlc_quotes {
44 0     0 0 0 my ($fq, @symbol_list) = @_;
45 0         0 my $ua = $fq->user_agent;
46 0         0 my %quotes;
47              
48 0         0 foreach my $symbol (@symbol_list) {
49 0         0 my $url = make_url ($symbol);
50              
51 0         0 my $req = HTTP::Request->new ('GET', $url);
52 0         0 $ua->prepare_request ($req);
53 0         0 $req->accept_decodable; # we know decoded_content() below
54 0         0 $req->user_agent (__PACKAGE__."/$VERSION " . $req->user_agent);
55             ### Request: $req->as_string
56              
57 0         0 my $resp = $ua->request ($req);
58 0         0 resp_to_quotes ($fq, $resp, \%quotes, $symbol);
59             }
60 0 0       0 return wantarray() ? %quotes : \%quotes;
61             }
62              
63             # Sample url:
64             # https://www.mlc.com.au/masterkeyWeb/execute/UnitPricesWQO?openAgent&reporttype=HistoricalDateRange&product=MasterKey%20Allocated%20Pension%20%28Five%20Star%29&fund=MLC%20Horizon%201%20-%20Bond%20Portfolio&begindate=19/05/2010&enddate=28/05/2010&
65             #
66             # The end date is today Sydney time. Sydney timezone is +10, and +11 during
67             # daylight savings; but instead of figuring when daylight savings is in
68             # force just use +11 all the time.
69             #
70             # Obviously today's price won't be available just after midnight, so a time
71             # offset giving today after 9am or 4pm or some such could make more sense.
72             # Actually as of Feb 2009 price for a given day aren't available until the
73             # afternoon of the next weekday, so the end date used here is going to be
74             # anything from 1 to 4 days too much. It does no harm to ask beyond what's
75             # available.
76             #
77             # The start date requested takes account of the slackness in the end date
78             # and the possibility of public holidays. The worst case is on Tuesday
79             # morning. The available price is still only the previous Friday, and if
80             # Thu/Fri are Christmas day and boxing day holidays then only Wednesday is
81             # available, and then want also the preceding day to get the prev price,
82             # which means the Tuesday, which is -7 days. Go back 2 further days just in
83             # case too, for a total -9!
84             #
85             sub make_url {
86 0     0 0 0 my ($symbol) = @_;
87              
88 0         0 my $t = time();
89 0         0 my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
90             = gmtime($t + 11 * 3600);
91 0         0 my $hi_day = $mday;
92 0         0 my $hi_month = $mon + 1;
93 0         0 my $hi_year = $year + 1900;
94              
95 0         0 ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
96             = gmtime($t + 10 * 3600 - 9 * 86400);
97 0         0 my $lo_day = $mday;
98 0         0 my $lo_month = $mon + 1;
99 0         0 my $lo_year = $year + 1900;
100              
101 0         0 my ($fund, $product) = symbol_to_fund_and_product ($symbol);
102              
103 0         0 require URI::Escape;
104 0         0 return sprintf ('https://www.mlc.com.au/masterkeyWeb/execute/UnitPricesWQO?openAgent&reporttype=HistoricalDateRange&product=%s&fund=%s&begindate=%02d/%02d/%04d&enddate=%02d/%02d/%04d&',
105             URI::Escape::uri_escape ($product),
106             URI::Escape::uri_escape ($fund),
107             $lo_day, $lo_month, $lo_year,
108             $hi_day, $hi_month, $hi_year);
109             }
110              
111             sub symbol_to_fund_and_product {
112 2     2 0 1681 my ($symbol) = @_;
113 2         5 my $pos = index ($symbol, ',');
114 2 100       5 if ($pos == -1) {
115 1         4 return ($symbol, '');
116             } else {
117 1         5 return (substr ($symbol, 0, $pos),
118             substr ($symbol, $pos+1));
119             }
120             }
121              
122             # store to hashref $quotes for $symbol based on HTTP::Response in $resp
123             #
124             # Initial line like:
125             #
126             # historicalProduct1funds[0]="All Funds"
127             #
128             # Then price lines like:
129             #
130             # historicalProduct1funds[1]="MLC Property Securities Fund,MasterKey Superannuation (Gold Star),29 March 2007,64.71567,0.00000";
131             #
132             sub resp_to_quotes {
133 0     0 0   my ($fq, $resp, $quotes, $symbol) = @_;
134              
135 0           $quotes->{$symbol,'method'} = 'mlc';
136 0           $quotes->{$symbol,'currency'} = 'AUD';
137 0           $quotes->{$symbol,'source'} = __PACKAGE__;
138 0           $quotes->{$symbol,'success'} = 1;
139              
140 0           my $content = $resp->decoded_content (raise_error => 1, charset => 'none');
141 0 0         if (! $resp->is_success) {
142 0           $quotes->{$symbol,'success'} = 0;
143 0           $quotes->{$symbol,'errormsg'} = $resp->status_line;
144 0           return;
145             }
146              
147 0 0         if ($content =~ /No unit prices available/i) {
148 0           $quotes->{$symbol,'success'} = 0;
149 0           $quotes->{$symbol,'errormsg'} = 'No unit prices available';
150 0           return;
151             }
152              
153 0           my @data; # elements are arrayrefs [ $isodate, $price ]
154              
155 0           while ($content =~ /^historicalProduct1funds.*=\"(.*)\"/mg) {
156 0           my ($got_fund, $got_product, $date, $price) = split /,/, $1;
157              
158             # skip historicalProduct1funds[0]="All Funds" bit
159 0 0         if (! $got_product) { next; }
  0            
160              
161 0           $date = dmy_to_iso ($fq, $date);
162 0           push @data, [ $date, $price ];
163             ### $date
164             ### $price
165             }
166 0 0         if (! @data) {
167 0           $quotes->{$symbol,'success'} = 0;
168 0           $quotes->{$symbol,'errormsg'}
169             = 'Oops, prices not matched in downloaded data';
170 0           return;
171             }
172              
173             # the lines come with newest date first, but don't assume that;
174             # sort to oldest date in $data[0], newest in endmost elem
175 0           @data = sort {$a->[0] cmp $b->[0]} @data;
  0            
176              
177 0           $fq->store_date($quotes, $symbol, {isodate => $data[-1]->[0]});
178 0           $quotes->{$symbol,'last'} = $data[-1]->[1];
179 0 0         if (@data > 1) {
180 0           $quotes->{$symbol,'close'} = $data[-2]->[1];
181             }
182 0           $quotes->{$symbol,'copyright_url'} = COPYRIGHT_URL;
183             }
184              
185             sub dmy_to_iso {
186 0     0 0   my ($fq, $dmy) = @_;
187 0           my %dummy_quotes;
188 0           $fq->store_date (\%dummy_quotes, '', {eurodate => $dmy});
189 0           return $dummy_quotes{'','isodate'};
190             }
191              
192             1;
193             __END__