| Subject: | New US treasury bond source: http://www.treasurydirect.gov/BC/SBCPrice |
I've written the attached module to fetch US Treasury bond values from
http://www.treasurydirect.gov/BC/SBCPrice.
I'm currently using it from within gnucash to automatically fetch all my
bond values, and it'd be great to have it included with Finance::Quote.
There's currently USFedBonds.pm, which refers to data from
http://www.publicdebt.treas.gov/sav/ which is no longer available. It
also doesn't allow me to specify the denomination, so I wouldn't be able
to use it within Gnucash. (I believe USFedBonds.pm assumes a
denomination of $25, so in Gnucash I would have to, for example, model a
50 dollar bond as two $25 bonds).
| Subject: | USTreasuryDirectBonds.pm |
#!/usr/bin/perl -w
#
# USTreasuryDirectBonds.pm
#
# Jason Kivlighn
# jason.kivlighn@gmail.com
# 2009.11.28
package Finance::Quote::USTreasuryDirectBonds;
require 5.004;
use strict;
use LWP::UserAgent;
use HTTP::Request::Common;
use HTML::TreeBuilder;
my $TREASURY_MAINURL = ("http://www.treasurydirect.gov/");
my $TREASURY_URL = ( $TREASURY_MAINURL . "BC/SBCPrice" );
sub methods {
return ( ustreasurydirectbonds => \&treasury );
}
sub labels {
my @labels =
qw/method source name symbol currency last date isodate nav price/;
return ( ustreasurydirectbonds => \@labels );
}
sub months_after_aug_1942 {
my $month = shift;
my $year = shift;
return ( $year - 1942 ) * 12 + $month + 8;
}
sub treasury {
my $quoter = shift;
my @symbols = @_;
return unless @symbols;
#my @symbols = ('$50 EE.01.1988', '$50 EE.06.1992', '$1000 EE.09.1987');
my %info;
my $ua = $quoter->user_agent;
my (@denominationList, @seriesList, @issueDateList);
my @valid_symbols;
foreach my $symbol (@symbols) {
my ( $denom, $series, $issuemonth, $issueyear ) =
( $symbol =~ m!^\$(\d*) (.*)\.(\d{1,2})\.(\d{4})! );
if ( !defined($series)
|| !defined($issueyear)
|| !defined($issuemonth) )
{
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = "Parse error";
next;
}
push @denominationList, $denom;
push @seriesList, $series;
push @issueDateList, months_after_aug_1942( $issuemonth, $issueyear );
push @valid_symbols, $symbol;
}
return wantarray() ? %info : \%info if @valid_symbols == 0;
my ( $a, $a, $a, $a, $redemptionmonth, $redemptionyear, $a, $a, $a ) = localtime;
$redemptionmonth = $redemptionmonth + 1;
$redemptionyear = $redemptionyear + 1900;
# Updated values are available every six months. We're going to look back 6 months from now
# get the next accrual date from that time, and then finally fetch values from that date.
# What we end up with is the value at the date of the last accrual.
$redemptionmonth = $redemptionmonth - 6;
if ($redemptionmonth < 1) {
$redemptionmonth = $redemptionmonth + 12;
$redemptionyear = $redemptionyear - 1;
}
my %form = (
IssueDateList => join(';', @issueDateList) . ';',
SeriesList => join(';', @seriesList) . ';',
DenominationList => join(';', @denominationList) . ';',
NextAccrualDateList => ' ;'x@valid_symbols,
MaturityDateList => ' ;'x@valid_symbols,
Version => '6',
RedemptionDate => "$redemptionmonth/$redemptionyear",
'btnUpdate.x' => 'UPDATE',
);
# Fetch a list of next accrual dates for each symbol
my $response = $ua->post( $TREASURY_URL, \%form );
if ( $response->is_success ) {
my $tree = HTML::TreeBuilder->new_from_content($response->content);
$tree->elementify();
my $nextAccrualDateElement = $tree->look_down(
sub {
$_[0]->tag() eq 'input' and $_[0]->attr('type') eq 'hidden'
and $_[0]->attr('name') eq 'NextAccrualDateList'
});
if (defined $nextAccrualDateElement) {
$nextAccrualDateElement->{value} =~ s/;$//;
# We can do fewer calls to the server by grouping requests by accrual date.
my %accrualDates;
my $i = 0;
foreach my $nextAccrualDate (split ";", $nextAccrualDateElement->{value}) {
push @{ $accrualDates{$nextAccrualDate} }, $i;
$i += 1;
}
while(my ($nextAccrualDate, $indices) = each(%accrualDates)) {
my $monthsSinceZero = $nextAccrualDate + 23295;
my $nextRedemptionYear = int($monthsSinceZero / 12);
my $nextRedemptionMonth = $monthsSinceZero % 12 + 1;
$form{SeriesList} = join(';', map { $seriesList[$_]; } @{$indices}) . ';';
$form{DenominationList} = join(';', map { $denominationList[$_]; } @{$indices}) . ';';
$form{IssueDateList} = join(';', map { $issueDateList[$_]; } @{$indices}) . ';';
$form{RedemptionDate} = "$nextRedemptionMonth/$nextRedemptionYear";
# Fetch the values at the last accrual date for all symbols with this accrual date
$response = $ua->post( $TREASURY_URL, \%form );
if ($response->is_success) {
my $tree = HTML::TreeBuilder->new_from_content($response->content);
$tree->elementify();
my $valueElement = ($tree->look_down(
sub {
$_[0]->tag() eq 'input' and $_[0]->attr('type') eq 'hidden'
and $_[0]->attr('name') eq 'ValueList'
}));
if (defined $valueElement) {
$valueElement->{value} =~ s/;$//;
my @valueList = split ";", $valueElement->{value};
my $i = 0;
foreach my $index (@{$indices}) {
$info{ $valid_symbols[$index], "method" } = "treasury";
$info{ $valid_symbols[$index], "price" } = $valueList[$i];
$info{ $valid_symbols[$index], "symbol" } = $valid_symbols[$index];
$info{ $valid_symbols[$index], "currency" } = "USD";
$info{ $valid_symbols[$index], "source" } = $TREASURY_MAINURL;
$info{ $valid_symbols[$index], "date" } = $nextRedemptionMonth . "/01/" . $nextRedemptionYear;
$info{ $valid_symbols[$index], "isodate" } = $nextRedemptionYear . "-" . $nextRedemptionMonth . "-01";
$info{ $valid_symbols[$index], "version" } = "1.0";
$info{ $valid_symbols[$index], "success" } = 1;
$i += 1;
}
} else {
$info{ $valid_symbols[$i], "success" } = 0;
$info{ $valid_symbols[$i], "errormsg" } = "Unexpected result from server. Server interface may have changed.";
}
$tree->delete;
} else {
$info{ $valid_symbols[$i], "success" } = 0;
$info{ $valid_symbols[$i], "errormsg" } = "POST failed";
}
}
$tree->delete;
} else {
foreach my $symbol (@valid_symbols) {
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = "Unexpected result from server. Server interface may have changed.";
}
}
} else {
foreach my $symbol (@valid_symbols) {
$info{ $symbol, "success" } = 0;
$info{ $symbol, "errormsg" } = "POST failed";
}
}
return wantarray() ? %info : \%info;
}
1;
=head1 NAME
Finance::Quote::USTreasuryDirectBonds - Get US Treasury Bond redemption values directly from the treasury at http://www.treasurydirect.gov/BC/SBCPrice
=head1 SYNOPSIS
use Finance::Quote;
$q = Finance::Quote->new;
=head1 DESCRIPTION
Access redemption values for US Federal Bonds from the treasury.
Bonds should be identified in the following manner:
$DENOMINATION SERIES.MM.YYYY
e.g. '$50 EE.01.1988'
=head1 LABELS RETURNED
...
=head1 SEE ALSO
Treasury bond value web interface - http://www.treasurydirect.gov/BC/SBCPrice
Finance::Quote
=head1 AUTHOR
Jason Kivlighn (jason.kivlighn@gmail.com)
=cut