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 30package Finance::Quote::Tiaacref; 31require 5.005; 32 33use strict; 34 35use Encode qw/decode/; 36use Time::Piece; 37use Time::Seconds; 38use Try::Tiny; 39 40our $VERSION = '1.51'; # VERSION 41 42# URLs of where to obtain information. 43my $TIAA_MAIN_URL = 'https://www.tiaa.org/public/investment-performance'; 44my $TIAA_DATA_URL = 'https://www.tiaa.markitondemand.com/Research/Public/Export/Details'; 45 46sub methods { return (tiaacref=>\&tiaacref); } 47 48sub 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 171sub tiaacref { 172 173 my $quoter = shift; 174 175 my @symbols = @_; 176 return unless scalar @symbols; 177 178 my %info; 179 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 my $end = localtime; 184 my $start = $end - ONE_WEEK; 185 186 #Need to fetch a session key first 187 my $session_key; 188 my $fail_msg; 189 my $res = $ua->get( $TIAA_MAIN_URL ); 190 if (! $res->is_success) { 191 $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 if ($res->content =~ /\bMODKey=\'([^']+)'/) { 197 $session_key = $1; 198 } 199 else { 200 $fail_msg = "Failed to fetch session key from TIAA site. Please" 201 . " contact the developers for further assistance." 202 } 203 } 204 if (defined $fail_msg) { 205 for my $symbol (@symbols) { 206 $info{ $symbol, "success" } = 0; 207 $info{ $symbol, "errormsg" } = $fail_msg; 208 } 209 return %info if wantarray; 210 return \%info; 211 } 212 213 SYMBOL: 214 for my $symbol (@symbols) { 215 216 my $payload = { 217 xids => [$symbol], 218 exportType => 'CSV', 219 startDate => $start->mdy, 220 endDate => $end->mdy, 221 selectedDetails => '', 222 }; 223 224 my $url = join '?', 225 $TIAA_DATA_URL, 226 $session_key, 227 ; 228 my $res = $ua->post($url, $payload); 229 if (! $res->is_success) { 230 $info{ $symbol, "success" } = 0; 231 $info{ $symbol, "errormsg" } = "There was an error fetching data" 232 . " for $symbol. HTTP status returned: " . $res->status_line; 233 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 my $csv = decode( 'UTF-16LE', $res->content ); 241 open my $stream, '<', \$csv; 242 while (my $line = <$stream>) { 243 244 chomp $line; 245 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 if (! defined $date) { 251 $info{ $symbol, "success" } = 0; 252 $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 next SYMBOL; 257 } 258 try { 259 $date = Time::Piece->strptime($date, "%m/%d/%Y"); 260 } catch { 261 $info{ $symbol, "success" } = 0; 262 $info{ $symbol, "errormsg" } = 263 "Error parsing date ($date) for $symbol. Please" 264 . " contact the developers for further assistance."; 265 next SYMBOL; 266 }; 267 $info{ $symbol, "success" } = 1; 268 $info{ $symbol, "symbol" } = $symbol; 269 $info{ $symbol, "exchange" } = "TIAA"; 270 $info{ $symbol, "name" } = $description; 271 $info{ $symbol, "nav" } = $price; 272 $info{ $symbol, "price" } = $info{$symbol, "nav"}; 273 $info{ $symbol, "currency" } = "USD"; 274 $info{ $symbol, "method" } = "tiaacref"; 275 $info{ $symbol, "isodate" } = $date->ymd; 276 $info{ $symbol, "date" } = $date->mdy('/'); 277 $quoter->store_date( 278 \%info, 279 $symbol, 280 {isodate => $date->ymd} 281 ); 282 283 last; # IMPORTANT: don't parse older data! 284 285 } 286 287 } 288 289 return %info if wantarray; 290 return \%info; 291 292} 293 2941; 295 296=head1 NAME 297 298Finance::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 310This module obtains information about TIAA-CREF managed funds. 311 312This module is loaded by default on a Finance::Quote object. It's 313also possible to load it explicitly by passing "Tiaacref" in to the 314argument list of Finance::Quote->new(). 315 316Information returned by this module is governed by TIAA's terms 317and conditions. 318 319=head1 LABELS RETURNED 320 321The following labels may be returned by Finance::Quote::Tiaacref: 322symbol, exchange, name, date, nav, price. 323 324=head1 SEE ALSO 325 326TIAA, L<http://www.tiaa.org> 327 328=cut 329