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

# Copyright 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011, 2014, 2015 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 .

package Finance::Quote::MLC;
use strict;

use vars qw($VERSION);
$VERSION = 14;

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

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

                      copyright_url
                    ) ]);
}

use constant COPYRIGHT_URL =>
  'http://www.mlc.com.au/mlc/im_considering_mlc/personal/footer_tools/advice_warning_and_disclaimer';


sub mlc_quotes {
  my ($fq, @symbol_list) = @_;
  my $ua = $fq->user_agent;
  my %quotes;

  foreach my $symbol (@symbol_list) {
    my $url = make_url ($symbol);

    my $req = HTTP::Request->new ('GET', $url);
    $ua->prepare_request ($req);
    $req->accept_decodable; # we know decoded_content() below
    $req->user_agent (__PACKAGE__."/$VERSION " . $req->user_agent);
    ### Request: $req->as_string

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

# Sample url:
# 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&
#
# The end date is today Sydney time.  Sydney timezone is +10, and +11 during
# daylight savings; but instead of figuring when daylight savings is in
# force just use +11 all the time.
#
# Obviously today's price won't be available just after midnight, so a time
# offset giving today after 9am or 4pm or some such could make more sense.
# Actually as of Feb 2009 price for a given day aren't available until the
# afternoon of the next weekday, so the end date used here is going to be
# anything from 1 to 4 days too much.  It does no harm to ask beyond what's
# available.
#
# The start date requested takes account of the slackness in the end date
# and the possibility of public holidays.  The worst case is on Tuesday
# morning.  The available price is still only the previous Friday, and if
# Thu/Fri are Christmas day and boxing day holidays then only Wednesday is
# available, and then want also the preceding day to get the prev price,
# which means the Tuesday, which is -7 days.  Go back 2 further days just in
# case too, for a total -9!
#
sub make_url {
  my ($symbol) = @_;

  my $t = time();
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
    = gmtime($t + 11 * 3600);
  my $hi_day = $mday;
  my $hi_month = $mon + 1;
  my $hi_year = $year + 1900;

  ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
    = gmtime($t + 10 * 3600 - 9 * 86400);
  my $lo_day = $mday;
  my $lo_month = $mon + 1;
  my $lo_year = $year + 1900;

  my ($fund, $product) = symbol_to_fund_and_product ($symbol);

  require URI::Escape;
  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&',
                  URI::Escape::uri_escape ($product),
                  URI::Escape::uri_escape ($fund),
                  $lo_day, $lo_month, $lo_year,
                  $hi_day, $hi_month, $hi_year);
}

sub symbol_to_fund_and_product {
  my ($symbol) = @_;
  my $pos = index ($symbol, ',');
  if ($pos == -1) {
    return ($symbol, '');
  } else {
    return (substr ($symbol, 0, $pos),
            substr ($symbol, $pos+1));
  }
}

# store to hashref $quotes for $symbol based on HTTP::Response in $resp
#
# Initial line like:
#
#   historicalProduct1funds[0]="All Funds"
#
# Then price lines like:
#
#   historicalProduct1funds[1]="MLC Property Securities Fund,MasterKey Superannuation (Gold Star),29 March 2007,64.71567,0.00000";
#
sub resp_to_quotes {
  my ($fq, $resp, $quotes, $symbol) = @_;

  $quotes->{$symbol,'method'}   = 'mlc';
  $quotes->{$symbol,'currency'} = 'AUD';
  $quotes->{$symbol,'source'}   = __PACKAGE__;
  $quotes->{$symbol,'success'}  = 1;

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

  if ($content =~ /No unit prices available/i) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'} = 'No unit prices available';
    return;
  }

  my @data; # elements are arrayrefs [ $isodate, $price ]

  while ($content =~ /^historicalProduct1funds.*=\"(.*)\"/mg) {
    my ($got_fund, $got_product, $date, $price) = split /,/, $1;

    # skip historicalProduct1funds[0]="All Funds" bit
    if (! $got_product) { next; }

    $date = dmy_to_iso ($fq, $date);
    push @data, [ $date, $price ];
    ### $date
    ### $price
  }
  if (! @data) {
    $quotes->{$symbol,'success'}  = 0;
    $quotes->{$symbol,'errormsg'}
      = 'Oops, prices not matched in downloaded data';
    return;
  }

  # the lines come with newest date first, but don't assume that;
  # sort to oldest date in $data[0], newest in endmost elem
  @data = sort {$a->[0] cmp $b->[0]} @data;

  $fq->store_date($quotes, $symbol, {isodate => $data[-1]->[0]});
  $quotes->{$symbol,'last'} = $data[-1]->[1];
  if (@data > 1) {
    $quotes->{$symbol,'close'} = $data[-2]->[1];
  }
  $quotes->{$symbol,'copyright_url'} = COPYRIGHT_URL;
}

sub dmy_to_iso {
  my ($fq, $dmy) = @_;
  my %dummy_quotes;
  $fq->store_date (\%dummy_quotes, '', {eurodate => $dmy});
  return $dummy_quotes{'','isodate'};
}

1;
__END__