# Copyright 2008, 2009, 2010 Kevin Ryde
# This file is part of Chart.
#
# Chart 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.
#
# Chart 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 Chart. If not, see <http://www.gnu.org/licenses/>.
package App::Chart::Suffix::FQ;
use 5.010;
use strict;
use warnings;
use Carp;
use List::Util qw(min max);
use List::MoreUtils;
use Locale::TextDomain 'App-Chart';
use App::Chart::Download;
use App::Chart::LatestHandler;
use App::Chart::Sympred;
use App::Chart::Weblink;
use constant DEBUG => 0;
my $pred = App::Chart::Sympred::Suffix->new ('.FQ');
#-----------------------------------------------------------------------------
# specifics
{ my $tsp_pred = App::Chart::Sympred::Suffix->new ('.tsp.FQ');
App::Chart::TZ->newyork->setup_for_symbol ($tsp_pred);
# only home page, per their "Linkage to the TSP Web Site"
App::Chart::Weblink->new
(pred => $tsp_pred,
name => __('_TSP Home Page'),
desc => __('Open web browser at the US Government Thrift Savings Plan'),
proc => sub {
eval { require Finance::Quote::TSP }
&& $Finance::Quote::TSP::TSP_MAIN_URL;
});
}
{ my $usfed_pred = App::Chart::Sympred::Suffix->new ('.usfedbonds.FQ');
App::Chart::Weblink->new
(pred => $usfed_pred,
name => __('_Fed Bonds Home Page'),
desc => __('Open web browser at the US Treasury Federal Bonds site'),
# $TREASURY_MAINURL is private
url => 'http://www.publicdebt.treas.gov/');
}
#-----------------------------------------------------------------------------
App::Chart::LatestHandler->new
(pred => $pred,
proc => \&latest_download);
my $FQ_re = qr/\.([^.]+)\.FQ$/p;
sub fq_symbol_method {
my ($symbol) = @_;
$symbol =~ $FQ_re or croak "Not an FQ symbol '$symbol'";
return $1;
}
sub fq_symbol_sans_suffix {
my ($symbol) = @_;
$symbol =~ $FQ_re or croak "Not an FQ symbol '$symbol'";
return ${^PREMATCH};
}
sub latest_download {
my ($symbol_list) = @_;
# split by method, preserving order among methods
# ENHANCE-ME: could preserve order for "separate request" sources, just
# join up the multiple request ones
require Tie::IxHash;
my %sm;
tie %sm, 'Tie::IxHash';
foreach my $symbol (@$symbol_list) {
$symbol =~ $FQ_re or croak "Not an FQ symbol: $symbol";
$symbol = ${^PREMATCH};
my $method = $1;
push @{$sm{$method}}, $symbol;
}
foreach my $method (keys %sm) {
my $symbol_list = $sm{$method};
if (DEBUG) { require Data::Dumper;
print "method $method ",
Data::Dumper->Dumper([$symbol_list],['symbol_list']); }
App::Chart::Download::status
(__x('Finance::Quote {method} {symbol_range}',
method => $method,
symbol_range => App::Chart::Download::symbol_range_string ($symbol_list)));
my $q = quoter_for_method ($method);
my $quotes = $q->fetch ($method, @$symbol_list);
my $h = quotes_to_group (".$method.FQ", $symbol_list, $quotes);
App::Chart::Download::write_latest_group ($h);
}
}
# Return a Finance::Quote->new object, hopefully able to fetch $method.
#
# If FQ_LOAD_QUOTELET and/or the defaults don't offer $method then it's
# attempted with method_to_modules() below added.
#
# It'd be possible to try method_to_modules() first, and that would normally
# load much less code than the defaults, but it might also miss something in
# the defaults, or grab something no wanted, so start with the defaults and
# only then search further.
#
sub quoter_for_method {
my ($method) = @_;
require Finance::Quote;
my $q = Finance::Quote->new;
if (! List::Util::first {$_ eq $method} $q->sources) {
my @modules = method_to_modules ($method);
if (DEBUG) { require Data::Dumper;
print "FQ attempt method='$method' in ",
Data::Dumper->new([\@modules],['modules'])->Dump; }
if (@modules) {
## no critic (RequireCheckingReturnValueOfEval)
eval { Finance::Quote->new (@modules) };
$q = Finance::Quote->new;
}
}
return $q;
}
# Return a list of modules which seem likely candidates for $method.
#
# The return is ready to pass to Finance::Quote->new, so it doesn't have a
# "Finance::Quote::" prefix, so for instance $method "tsp" might give just
# "TSP".
#
# This is meant to automatically pickup modules not in the defaults or in
# FQ_LOAD_QUOTELET. It can't cope with fallbacks offering extra sources for
# a given country etc, but it's much easier than adding to the env var
# whenever you install a new add-on.
#
sub method_to_modules {
my ($method) = @_;
# 'ftportfolios_direct' -> FTPortfolios.pm
# 'seb_funds' -> SEB.pm
# 'unionfunds' -> Union.pm
# 'aex_options' -> AEX.pm
# 'aex_futures' -> AEX.pm
# 'stockhousecanada_fund' -> StockHouseCanada.pm
$method =~ s/(_direct|_futures|_options|_?funds?)$//;
require Module::Find;
my @modules = Module::Find::findsubmod ('Finance::Quote');
foreach (@modules) { s/^Finance::Quote::// }
return grep /^\Q$method/i, @modules;
}
sub quotes_to_group {
my ($symbol_suffix, $symbol_list, $quotes) = @_;
if (DEBUG) { require Data::Dumper;
print Data::Dumper::Dumper($quotes); }
my @data = ();
my $h = { source => __PACKAGE__,
data => \@data };
foreach my $symbol (@$symbol_list) {
my $last = $quotes->{$symbol,'last'};
my $high = $quotes->{$symbol,'high'};
my $low = $quotes->{$symbol,'low'};
my $change = $quotes->{$symbol,'net'};
# Finance::Quote::Fidelity version 1.05 gives 'price' rather than 'last'
if (! defined $last) {
my $price = $quotes->{$symbol,'price'};
if (defined $price) {
$last = $price;
}
}
# Try making $change from 'close' (the previous close) and 'last'.
#
if (defined $last && ! defined $change) {
my $prev = $quotes->{$symbol,'close'};
if (defined $prev) {
$change = decimal_subtract ($last, $prev);
}
}
# Try making $change from 'p_change' and 'last'.
#
# $prev * (100 + $p_change) / 100 == $last
# $prev == $last * 100 / (100 + $p_change)
# $change == $last - $prev
# == $last - $last * 100 / (100 + $p_change)
# == $last * (1 - 100 / (100 + $p_change))
# == $last * $p_change / (100 + $p_change)
#
if (defined $last && ! defined $change) {
my $p_change = $quotes->{$symbol,'p_change'};
if (defined $p_change) {
$change = $last * $p_change / (100 + $p_change);
$change = sprintf ('%.*f', App::Chart::count_decimals($last), $change);
}
}
# Separate high/low in for instance Finance::Quote::ZA
# But Yahoo methods give just 'day_range'.
#
if (! defined $high) {
my $day_range = $quotes->{$symbol,'day_range'};
if (defined $day_range) {
if ($day_range =~ /^([0-9.]+)-([0-9.]+)$/) {
$high = $1;
$low = $2;
} else {
carp "Unrecognised $symbol 'day_range': $day_range";
}
}
}
# Not needed any more
# my $volume = $quotes->{$symbol,'volume'};
# # Try approximating $volume from 'dollar_volume' and 'last'.
# # dollar_volume given by Finance::Quote::Casablanca
# #
# if ($last && ! defined $volume) {
# my $dollar_volume = $quotes->{$symbol,'dollar_volume'};
# if (defined $dollar_volume) {
# $volume = int ($dollar_volume / $last + 0.5); # round to nearest
# }
# }
my $errormsg;
if (! $quotes->{$symbol,'success'}) {
$errormsg = $quotes->{$symbol,'errormsg'};
if (! defined $errormsg) {
if (List::MoreUtils::any {/^$symbol$;/} keys %$quotes) {
$errormsg = __('Unknown error');
} else {
$errormsg = __('No data from FQ method');
}
}
}
# If 'ex_div' is yahoo style then it needs munging ...
# $quotes->{$symbol,'div'},
# $quotes->{$symbol,'ex_div'},
push @data, { symbol => $symbol . $symbol_suffix,
name => $quotes->{$symbol,'name'},
quote_date => $quotes->{$symbol,'isodate'},
quote_time => $quotes->{$symbol,'time'},
bid => $quotes->{$symbol,'bid'},
offer => $quotes->{$symbol,'ask'},
last_date => $quotes->{$symbol,'isodate'},
last_time => $quotes->{$symbol,'time'},
open => $quotes->{$symbol,'open'},
high => $high,
low => $low,
last => $last,
change => $change,
volume => $quotes->{$symbol,'volume'},
currency => $quotes->{$symbol,'currency'},
error => $errormsg,
# various of mine
copyright => $quotes->{$symbol,'copyright_url'},
};
}
if (DEBUG) { require Data::Dumper;
print Data::Dumper::Dumper($h); }
return $h;
}
# Return the difference $x - $y, done as a "decimal" subtract, so retaining
# as many decimal places there are on $x and $y.
# It's done with some sprint %f fakery, not actual decimal arithmetic, but
# that's close enough for 4 decimal place currencies.
sub decimal_subtract {
my ($x, $y) = @_;
my $decimals = max (App::Chart::count_decimals($x),
App::Chart::count_decimals($y));
return sprintf ('%.*f', $decimals, $x - $y);
}
1;
__END__