File Coverage

blib/lib/Finance/Quote/Tiaacref.pm
Criterion Covered Total %
statement 17 73 23.2
branch 0 16 0.0
condition n/a
subroutine 7 10 70.0
pod 0 3 0.0
total 24 102 23.5


line stmt bran cond sub pod time code
1             #!/usr/bin/perl -w
2             #
3             # Copyright (C) 1998, Dj Padzensky <djpadz@padz.net>
4             # Copyright (C) 1998, 1999 Linas Vepstas <linas@linas.org>
5             # Copyright (C) 2000, Yannick LE NY <y-le-ny@ifrance.com>
6             # Copyright (C) 2000, Paul Fenwick <pjf@cpan.org>
7             # Copyright (C) 2000, Brent Neal <brentn@users.sourceforge.net>
8             #
9             # This program is free software; you can redistribute it and/or modify
10             # it under the terms of the GNU General Public License as published by
11             # the Free Software Foundation; either version 2 of the License, or
12             # (at your option) any later version.
13             #
14             # This program is distributed in the hope that it will be useful,
15             # but WITHOUT ANY WARRANTY; without even the implied warranty of
16             # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17             # GNU General Public License for more details.
18             #
19             # You should have received a copy of the GNU General Public License
20             # along with this program; if not, write to the Free Software
21             # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
22             # 02110-1301, USA
23             #
24             #
25             # This code derived from Padzensky's work on package Finance::YahooQuote,
26             # but extends its capabilites to encompas a greater number of data sources.
27             #
28             # This code was developed as part of GnuCash <http://www.gnucash.org/>
29              
30             package Finance::Quote::Tiaacref;
31             require 5.005;
32              
33 5     5   2826 use strict;
  5         12  
  5         508  
34              
35 5     5   27 use Encode qw/decode/;
  5         12  
  5         232  
36 5     5   30 use Time::Piece;
  5         9  
  5         62  
37 5     5   444 use Time::Seconds;
  5         11  
  5         377  
38 5     5   32 use Try::Tiny;
  5         21  
  5         4582  
39              
40             our $VERSION = '1.58_01'; # TRIAL VERSION
41              
42             # URLs of where to obtain information.
43             my $TIAA_MAIN_URL = 'https://www.tiaa.org/public/investment-performance';
44             my $TIAA_DATA_URL = 'https://www.tiaa.markitondemand.com/Research/Public/Export/Details';
45              
46 5     5 0 25 sub methods { return (tiaacref=>\&tiaacref); }
47              
48 5     5 0 23 sub labels { return (tiaacref => [qw/
49             method
50             symbol
51             exchange
52             name
53             date
54             isodate
55             nav
56             price
57             currency
58             /]); }
59              
60             # =======================================================================
61             # TIAA-CREF Annuities are not listed on any exchange, unlike their mutual funds
62             # TIAA-CREF provides unit values via a cgi on their website. The cgi returns
63             # a csv file in the format
64             # description,price1,date1
65             # description,price2,date2
66             # ..etc.
67              
68             # As of 11-Oct-2020, the following securities are found in their lookup
69             # service. Data for some of these are available elsewhere and some are not:
70              
71             # QCBMIX QCBMPX QCBMRX QCEQIX QCEQPX QCEQRX QCGLIX QCGLPX QCGLRX
72             # QCGRIX QCGRPX QCGRRX QCILIX QCILPX QCILRX QCMMIX QCMMPX QCMMRX
73             # QCSCIX QCSCPX QCSCRX QCSTIX QCSTPX QCSTRX QREARX TAISX TAIWX
74             # TBBWX TBIAX TBIIX TBILX TBIPX TBIRX TBIWX TBPPX TCBHX
75             # TCBPX TCBRX TCBWX TCCHX TCEPX TCFPX TCHHX TCHPX TCIEX
76             # TCIHX TCIIX TCILX TCIWX TCIXX TCLCX TCLEX TCLFX TCLHX
77             # TCLIX TCLNX TCLOX TCLPX TCLRX TCLTX TCMGX TCMHX TCMVX
78             # TCNHX TCNIX TCOIX TCQHX TCQPX TCREX TCRIX TCSEX TCSIX
79             # TCTHX TCTIX TCTPX TCTRX TCTWX TCWHX TCWIX TCWPX TCYHX
80             # TCYIX TCYPX TCZHX TCZPX TECGX TECWX TEDHX TEDLX TEDNX
81             # TEDPX TEDTX TEDVX TEIEX TEIHX TEIWX TELCX TELWX TEMHX
82             # TEMLX TEMPX TEMRX TEMSX TEMVX TENWX TEQHX TEQKX TEQLX
83             # TEQPX TEQSX TEQWX TESHX TEVIX TEWCX TFIHX TFIIX TFIPX
84             # TFIRX TFITX TFTHX TFTIX TGIHX TGIWX TGRKX TGRLX TGRMX
85             # TGRNX TGROX THCVX THCWX TIBDX TIBEX TIBFX TIBHX TIBLX
86             # TIBNX TIBUX TIBVX TIBWX TICHX TICRX TIDPX TIDRX TIEHX
87             # TIEIX TIERX TIEWX TIEXX TIGRX TIHHX TIHPX TIHRX TIHWX
88             # TIHYX TIIEX TIIHX TIILX TIIRX TIISX TIIWX TIKPX TIKRX
89             # TILGX TILHX TILIX TILPX TILRX TILVX TILWX TIMIX TIMRX
90             # TIMVX TINRX TIOHX TIOIX TIOPX TIORX TIOSX TIOTX TIOVX
91             # TIQRX TIREX TIRHX TIRTX TIRXX TISAX TISBX TISCX TISEX
92             # TISIX TISPX TISRX TISWX TITIX TITRX TIXHX TIXRX TIYRX
93             # TLFAX TLFIX TLFPX TLFRX TLGRX TLHHX TLHIX TLHPX TLHRX
94             # TLIHX TLIIX TLIPX TLIRX TLISX TLLHX TLLIX TLLPX TLLRX
95             # TLMHX TLMPX TLMRX TLPRX TLQHX TLQIX TLQRX TLRHX TLRIX
96             # TLRRX TLSHX TLSPX TLSRX TLTHX TLTIX TLTPX TLTRX TLVPX
97             # TLWCX TLWHX TLWIX TLWPX TLWRX TLXHX TLXIX TLXNX TLXPX
98             # TLXRX TLYHX TLYIX TLYPX TLYRX TLZHX TLZIX TLZRX TMHXX
99             # TNSHX TNWCX TPILX TPISX TPPXX TPSHX TPWCX TRBIX TRCIX
100             # TRCPX TRCVX TREPX TRERX TRGIX TRGMX TRGPX TRHBX TRIEX
101             # TRIHX TRILX TRIPX TRIRX TRIWX TRLCX TRLHX TRLIX TRLWX
102             # TRPGX TRPSX TRPWX TRRPX TRRSX TRSCX TRSEX TRSHX TRSPX
103             # TRVHX TRVPX TRVRX TSAHX TSAIX TSALX TSAPX TSARX TSBBX
104             # TSBHX TSBIX TSBPX TSBRX TSCHX TSCLX TSCTX TSCWX TSDBX
105             # TSDDX TSDFX TSDHX TSDJX TSFHX TSFPX TSFRX TSFTX TSGGX
106             # TSGHX TSGLX TSGPX TSGRX TSIHX TSILX TSIMX TSIPX TSITX
107             # TSMEX TSMHX TSMLX TSMMX TSMNX TSMOX TSMPX TSMTX TSMUX
108             # TSMWX TSOEX TSOHX TSONX TSOPX TSORX TSRPX TSTPX TTBHX
109             # TTBWX TTFHX TTFIX TTFPX TTFRX TTIHX TTIIX TTIPX TTIRX
110             # TTISX TTRHX TTRIX TTRLX TTRPX TVIHX TVIIX TVIPX TVITX
111             # W111# W113# W114# W115# W116# W117# W118# W119# W120#
112             # W121# W122# W123# W128# W130# W131# W132# W133# W134#
113             # W135# W136# W137# W138# W139# W140# W141# W142# W143#
114             # W144# W145# W146# W147# W148# W149# W150# W151# W152#
115             # W153# W154# W155# W156# W157# W158# W159# W160# W161#
116             # W162# W163# W164# W165# W166# W167# W168# W169# W170#
117             # W171# W172# W173# W174# W175# W176# W177# W178# W179#
118             # W180# W211# W213# W214# W215# W216# W217# W218# W219#
119             # W220# W221# W222# W223# W228# W230# W231# W232# W233#
120             # W234# W235# W236# W237# W238# W239# W240# W241# W242#
121             # W243# W244# W245# W246# W247# W248# W249# W250# W251#
122             # W252# W253# W254# W255# W256# W257# W258# W259# W260#
123             # W261# W262# W263# W264# W265# W266# W267# W268# W269#
124             # W270# W271# W272# W273# W274# W275# W276# W277# W278#
125             # W279# W280# W311# W313# W314# W315# W316# W317# W318#
126             # W319# W320# W321# W322# W323# W328# W330# W331# W332#
127             # W333# W334# W335# W336# W337# W338# W339# W340# W341#
128             # W342# W343# W344# W345# W346# W347# W348# W349# W350#
129             # W351# W352# W353# W354# W355# W356# W357# W358# W359#
130             # W360# W361# W362# W363# W364# W365# W366# W367# W368#
131             # W369# W370# W371# W372# W373# W374# W375# W376# W377#
132             # W378# W379# W380# W411# W413# W414# W415# W416# W417#
133             # W418# W419# W420# W421# W422# W423# W428# W430# W431#
134             # W432# W433# W434# W435# W436# W437# W438# W439# W440#
135             # W441# W442# W443# W444# W445# W446# W447# W448# W449#
136             # W450# W451# W452# W453# W454# W455# W456# W457# W458#
137             # W459# W460# W461# W462# W463# W464# W465# W466# W467#
138             # W468# W469# W470# W471# W472# W473# W474# W475# W476#
139             # W477# W478# W479# W480# W511# W512# W514# W515# W516#
140             # W517# W518# W519# W520# W521# W522# W523# W524# W525#
141             # W526# W527# W528# W529# W530# W531# W532# W533# W534#
142             # W535# W536# W537# W538# W539# W540# W541# W543# W544#
143             # W545# W546# W547# W548# W549# W550# W611# W612# W614#
144             # W615# W616# W617# W618# W619# W620# W621# W622# W623#
145             # W624# W625# W626# W627# W628# W629# W630# W631# W632#
146             # W633# W634# W635# W636# W637# W638# W639# W640# W641#
147             # W643# W644# W645# W646# W647# W648# W649# W650# W711#
148             # W712# W714# W715# W716# W717# W718# W719# W720# W721#
149             # W722# W723# W724# W725# W726# W727# W728# W729# W730#
150             # W731# W732# W733# W734# W735# W736# W737# W738# W739#
151             # W740# W741# W743# W744# W745# W746# W747# W748# W749#
152             # W750# W811# W812# W814# W815# W816# W817# W818# W819#
153             # W820# W821# W822# W823# W824# W825# W826# W827# W828#
154             # W829# W830# W831# W832# W833# W834# W835# W836# W837#
155             # W838# W839# W840# W841# W843# W844# W845# W846# W847#
156             # W848# W849# W850#
157             #
158             # This subroutine was written by Brent Neal <brentn@users.sourceforge.net>
159             # Modified to support new TIAA-CREF webpages by Kevin Foss <kfoss@maine.edu> and Brent Neal
160             # Modified to support new 2012 TIAA-CREF webpages by Carl LaCombe <calcisme@gmail.com>
161             # Modified to support new 2020 TIAA webpages by Jeremy Volkening
162              
163             #
164             # TODO:
165             #
166             # The TIAA-CREF cgi allows you to specify the exact dates for which to retrieve
167             # price data. That functionality could be worked into this subroutine.
168             # Currently, we only grab the most recent price data.
169             #
170              
171             sub tiaacref {
172              
173 0     0 0   my $quoter = shift;
174              
175 0           my @symbols = @_;
176 0 0         return unless scalar @symbols;
177              
178 0           my %info;
179 0           my $ua = $quoter->user_agent;
180              
181             # The TIAA data service wants a start and end date. To guarantee data,
182             # ask for 7 days of quotes, and only take the first (most recent) one.
183 0           my $end = localtime;
184 0           my $start = $end - ONE_WEEK;
185              
186             #Need to fetch a session key first
187 0           my $session_key;
188             my $fail_msg;
189 0           my $res = $ua->get( $TIAA_MAIN_URL );
190 0 0         if (! $res->is_success) {
191 0           $fail_msg = "Failed to fetch TIAA page from $TIAA_MAIN_URL. It may be"
192             . " that the link has changed. HTTP status returned: "
193             . $res->status_line;
194             }
195             else {
196 0 0         if ($res->content =~ /\bMODKey=\'([^']+)'/) {
197 0           $session_key = $1;
198             }
199             else {
200 0           $fail_msg = "Failed to fetch session key from TIAA site. Please"
201             . " contact the developers for further assistance."
202             }
203             }
204 0 0         if (defined $fail_msg) {
205 0           for my $symbol (@symbols) {
206 0           $info{ $symbol, "success" } = 0;
207 0           $info{ $symbol, "errormsg" } = $fail_msg;
208             }
209 0 0         return %info if wantarray;
210 0           return \%info;
211             }
212              
213             SYMBOL:
214 0           for my $symbol (@symbols) {
215              
216 0           my $payload = {
217             xids => [$symbol],
218             exportType => 'CSV',
219             startDate => $start->mdy,
220             endDate => $end->mdy,
221             selectedDetails => '',
222             };
223              
224 0           my $url = join '?',
225             $TIAA_DATA_URL,
226             $session_key,
227             ;
228 0           my $res = $ua->post($url, $payload);
229 0 0         if (! $res->is_success) {
230 0           $info{ $symbol, "success" } = 0;
231 0           $info{ $symbol, "errormsg" } = "There was an error fetching data"
232             . " for $symbol. HTTP status returned: " . $res->status_line;
233 0           next SYMBOL;
234             }
235              
236             # Data returned is in UTF-16-encoded CSV. As we asked for a week of
237             # data, successful queries will likely return multiple lines, but they
238             # are sorted in descending chronological order so we can just take
239             # the first one.
240 0           my $csv = decode( 'UTF-16LE', $res->content );
241 0           open my $stream, '<', \$csv;
242 0           while (my $line = <$stream>) {
243              
244 0           chomp $line;
245 0           my ($description, $price, $date) = split ',', $line;
246              
247             # if no data is found for the given symbol, no error is thrown
248             # but the content returned contains a textual error message. In
249             # this case, the latter fields will not be defined.
250 0 0         if (! defined $date) {
251 0           $info{ $symbol, "success" } = 0;
252 0           $info{ $symbol, "errormsg" } =
253             "Error retrieving quote for $symbol - no listing for this"
254             . " name found. Please check symbol and the two letter"
255             . " extension (if any)";
256 0           next SYMBOL;
257             }
258             try {
259 0     0     $date = Time::Piece->strptime($date, "%m/%d/%Y");
260             } catch {
261 0     0     $info{ $symbol, "success" } = 0;
262 0           $info{ $symbol, "errormsg" } =
263             "Error parsing date ($date) for $symbol. Please"
264             . " contact the developers for further assistance.";
265 0           next SYMBOL;
266 0           };
267 0           $info{ $symbol, "success" } = 1;
268 0           $info{ $symbol, "symbol" } = $symbol;
269 0           $info{ $symbol, "exchange" } = "TIAA";
270 0           $info{ $symbol, "name" } = $description;
271 0           $info{ $symbol, "nav" } = $price;
272 0           $info{ $symbol, "price" } = $info{$symbol, "nav"};
273 0           $info{ $symbol, "currency" } = "USD";
274 0           $info{ $symbol, "method" } = "tiaacref";
275 0           $info{ $symbol, "isodate" } = $date->ymd;
276 0           $info{ $symbol, "date" } = $date->mdy('/');
277 0           $quoter->store_date(
278             \%info,
279             $symbol,
280             {isodate => $date->ymd}
281             );
282              
283 0           last; # IMPORTANT: don't parse older data!
284              
285             }
286              
287             }
288              
289 0 0         return %info if wantarray;
290 0           return \%info;
291              
292             }
293              
294             1;
295              
296             =head1 NAME
297              
298             Finance::Quote::Tiaacref - Obtain quote from TIAA (formerly TIAA-CREF)
299              
300             =head1 SYNOPSIS
301              
302             use Finance::Quote;
303              
304             $q = Finance::Quote->new;
305              
306             %stockinfo = $q->fetch("tiaacref","TIAAreal");
307              
308             =head1 DESCRIPTION
309              
310             This module obtains information about TIAA-CREF managed funds.
311              
312             This module is loaded by default on a Finance::Quote object. It's
313             also possible to load it explicitly by passing "Tiaacref" in to the
314             argument list of Finance::Quote->new().
315              
316             Information returned by this module is governed by TIAA's terms
317             and conditions.
318              
319             =head1 LABELS RETURNED
320              
321             The following labels may be returned by Finance::Quote::Tiaacref:
322             symbol, exchange, name, date, nav, price.
323              
324             =head1 SEE ALSO
325              
326             TIAA, L<http://www.tiaa.org>
327              
328             =cut