Skip Menu |
 

This queue is for tickets about the Finance-Quote CPAN distribution.

Report information
The Basics
Id: 52105
Status: new
Priority: 0/
Queue: Finance-Quote

People
Owner: Nobody in particular
Requestors: jason.kivlighn [...] gmail.com
Cc:
AdminCc:

Bug Information
Severity: (no value)
Broken in: (no value)
Fixed in: (no value)



Subject: New US treasury bond source: http://www.treasurydirect.gov/BC/SBCPrice
Download (untitled) / with headers
text/plain 632b
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


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.