File Coverage

blib/lib/Finance/Quote/TreasuryDirect.pm
Criterion Covered Total %
statement 24 80 30.0
branch 0 24 0.0
condition n/a
subroutine 9 11 81.8
pod 0 4 0.0
total 33 119 27.7


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # TreasuryDirect.pm
4             #
5              
6             =begin comment
7              
8             perl -MData::Dumper -MFinance::Quote -le '$q = Finance::Quote->new(); print Dumper { $q->fetch("treasurydirect", @ARGV) };' 912810QT8 912810QY7
9              
10             =end comment
11              
12             =cut
13              
14             package Finance::Quote::TreasuryDirect;
15 5     5   2740 use strict;
  5         13  
  5         163  
16 5     5   26 use warnings;
  5         11  
  5         252  
17              
18              
19             #
20             # Modification of Rolf Endres' Finance::Quote::ZA
21             #
22             # Peter Ratzlaff <pratzlaff@gmail.com>
23             # April, 2018
24             #
25              
26             our $VERSION = '1.58'; # VERSION
27              
28 5     5   33 use vars qw /$VERSION/ ;
  5         11  
  5         220  
29              
30 5     5   40 use LWP::UserAgent;
  5         13  
  5         34  
31 5     5   151 use HTTP::Request::Common;
  5         13  
  5         391  
32 5     5   47 use HTML::TableExtract;
  5         14  
  5         36  
33 5     5   208 use HTTP::Request;
  5         11  
  5         60  
34              
35             my $TREASURY_DIRECT_URL = 'https://www.treasurydirect.gov/GA-FI/FedInvest/todaySecurityPriceDate.htm';
36              
37             sub methods {
38 5     5 0 23 return treasurydirect => \&treasurydirect;
39             }
40              
41              
42             sub labels {
43 5     5 0 19 my @labels = qw/ method source symbol rate bid ask price date isodate /;
44 5         17 return treasurydirect => \@labels;
45             }
46              
47             sub treasurydirect {
48              
49             # check for quotes for today, as well as the last three days
50              
51 0     0 0   my $time = time();
52 0           my @times = map { $time-86400*$_ } 0..3;
  0            
53              
54 0           for my $t (@times) {
55 0           my ($d, $m, $y) = (localtime($t))[3,4,5];
56 0           $y += 1900;
57 0           $m += 1;
58 0           my @quotes = treasurydirect_ymd($y, $m, $d, @_);
59 0 0         return @quotes if @quotes;
60             }
61              
62             }
63              
64             sub treasurydirect_ymd {
65              
66 0     0 0   my ($y, $m, $d, $quoter, @symbols) = @_;
67              
68 0 0         return unless @symbols;
69              
70 0           my %info;
71              
72 0           $info{$_, 'success'} = 0 for @symbols;
73              
74 0           my $ua = $quoter->user_agent;
75 0           $ua->timeout(10);
76 0           $ua->ssl_opts( verify_hostname => 0 );
77              
78 0           my $content;
79 0           my $url = $TREASURY_DIRECT_URL;
80             #print "[debug]: ", $url, "\n";
81              
82 0           if (0) {
83             my $response = $ua->request(GET $url);
84             #print "[debug]: ", $response->content, "\n";
85             if (!$response->is_success) {
86             $info{$_, 'errormsg'} = 'Error contacting URL' for @symbols;
87             return wantarray() ? %info : \%info;
88             }
89             $content = $response->content;
90             }
91              
92             # this is no longer working, for some reason
93             elsif (0) {
94             my $url = 'https://www.treasurydirect.gov/GA-FI/FedInvest/selectSecurityPriceDate';
95             # my $post_data = [ "priceDate.month" => "4", "priceDate.day" => "13", "priceDate.year" => "2018", "submit" => "Show+Prices" ];
96             my $post_data = [ 'priceDate.month' => $m,
97             'priceDate.day' => $d,
98             'priceDate.year' => $y,
99             'submit' => 'Show Prices',
100             ];
101              
102             my $request = POST( $url, $post_data);
103             my $resp = $ua->request($request);
104             if ($resp->is_success) {
105             $content = $resp->decoded_content;
106             # print "[debug]: ", $content, "\n";
107             } else {
108             $info{$_, 'errormsg'} = 'Error contacting URL' for @symbols;
109             return wantarray() ? %info : \%info;
110             }
111             }
112              
113             else {
114 0           my $url = 'https://www.treasurydirect.gov/GA-FI/FedInvest/selectSecurityPriceDate';
115             #my $data= 'priceDate.month=1&priceDate.day=4&priceDate.year=2021&submit=Show+Prices';
116              
117 0           my $data =
118             'priceDate.month=' . $m .
119             '&priceDate.day=' . $d .
120             '&priceDate.year=' . $y .
121             '&submit=Show+Prices';
122              
123 0           $content = `wget --no-check-certificate --post-data='$data' $url -O - 2>/dev/null`;
124             }
125              
126             # submitted a future date
127 0 0         return if $content =~ /Submitted date must be equal to/;
128              
129             # weekends, holidays (doesn't work like this any more)
130 0 0         return if $content =~ /No data for selected date range/;
131              
132 0           my ($date, $isodate);
133 0 0         if ($content =~ /Prices For:\s+(\w+)\s+(\d+),\s+(\d+)/) {
134 0           my @months = qw/ Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec /;
135 0           my %months; @months{@months} = 1..12;
  0            
136 0           my ($year, $month, $day) = ($3, $months{$1}, $2);
137 0           $date = sprintf "%02d/%02d/%04d", $month, $day, $year;
138 0           $isodate = sprintf "%04d-%02d-%02d", $year, $month, $day;
139             }
140              
141 0           my $te = new HTML::TableExtract();
142 0           $te->parse($content);
143             # print "[debug]: (parsed HTML)",$te, "\n";
144              
145 0 0         unless ($te->first_table_found()) {
146             #print STDERR "no tables on this page\n";
147 0           $info{$_, 'errormsg'} = 'Parse error' for @symbols;
148 0 0         return wantarray() ? %info : \%info;
149             }
150              
151             # Debug to dump all tables in HTML...
152              
153             =begin comment
154              
155             print "\n \n \n \n[debug]: ++++ ==== ++++ ==== ++++ ==== ++++ ==== START OF TABLE DUMP ++++ ==== ++++ ==== ++++ ==== ++++ ==== \n \n \n \n";
156              
157             for my $ts ($te->table_states) {
158              
159             printf "\n \n \n \n[debug]: //// \\\\ //// \\\\ //// \\\\ //// \\\\ START OF TABLE %d,%d //// \\\\ //// \\\\ //// \\\\ //// \\\\ \n \n \n \n",
160             $ts->depth, $ts->count;
161              
162             for my $row ($ts->rows) {
163             print '[debug]: ', join('|', map { defined $_ ? $_ : 'undef' } @$row), "\n";
164             }
165             }
166              
167             print "\n \n \n \n[debug]: ++++ ==== ++++ ==== ++++ ==== ++++ ==== END OF TABLE DUMP ++++ ==== ++++ ==== ++++ ==== ++++ ==== \n \n \n \n";
168              
169             =end comment
170              
171             =cut
172              
173 0           my %bonds;
174 0           for my $ts ($te->table_states) {
175 0           for my $row ($ts->rows) {
176 0           $bonds{$row->[0]} = {
177             rate => $row->[2],
178             maturity => $row->[3],
179             bid => $row->[5],
180             ask => $row->[6],
181             };
182             }
183             }
184              
185             # no bonds were returned, probably due to being a weekend or holiday
186 0 0         return unless keys(%bonds) > 1;
187              
188 0           for my $symbol (@symbols) {
189              
190             # GENERAL FIELDS
191 0           $info{$symbol, 'method'} = 'treasurydirect';
192 0           $info{$symbol, 'symbol'} = $symbol;
193 0           $info{$symbol, 'source'} = $TREASURY_DIRECT_URL;
194              
195             # OTHER INFORMATION
196 0 0         if (exists $bonds{$symbol}) {
197              
198 0           $info{$symbol, 'success'} = 1;
199 0           $info{$symbol, 'currency'} = 'USD';
200              
201 0           $info{$symbol, $_} = $bonds{$symbol}{$_} for keys %{$bonds{$symbol}};
  0            
202              
203 0           $info{$symbol, 'price'} = sprintf("%.2f", 0.5*($info{$symbol, 'bid'} + $info{$symbol, 'ask'}));
204              
205 0 0         $info{$symbol, 'date'} = $date if defined $date;
206 0 0         $info{$symbol, 'isodate'} = $isodate if defined $isodate;
207             }
208             else {
209 0           $info{$symbol, 'errormsg'} = 'no match';
210             }
211              
212             }
213              
214 0 0         return wantarray() ? %info : \%info;
215             }
216              
217             1;
218              
219             __END__
220              
221             =head1 NAME
222              
223             Finance::Quote::TreasuryDirect - Obtain bond quotes from Treasury Direct
224              
225             =head1 SYNOPSIS
226              
227             use Finance::Quote;
228              
229             $q = Finance::Quote->new;
230              
231             %info = $q->fetch('treasurydirect', '912810QT8');
232              
233             =head1 DESCRIPTION
234              
235             This module obtains individual bond quotes by CUSIP number from
236             treasurydirect.gov
237              
238             =head1 LABELS RETURNED
239              
240             Information available from Treasury Direct may include the following labels:
241              
242             method source symbol rate bid ask price date isodate
243              
244             =head1 SEE ALSO
245              
246             treasurydirect.gov
247              
248             Finance::Quote
249              
250             =cut