PageRenderTime 71ms CodeModel.GetById 23ms RepoModel.GetById 0ms app.codeStats 1ms

/smtm

https://github.com/gitpan/smtm
Perl | 1810 lines | 1588 code | 164 blank | 58 comment | 276 complexity | ea39aa08458a9ccb88c44c12cd8aec74 MD5 | raw file
Possible License(s): GPL-2.0
  1. #!/usr/bin/perl -w
  2. #
  3. # smtm --- A global stock ticker for X11 and Windoze
  4. #
  5. # Copyright (C) 1999 - 2008 Dirk Eddelbuettel <edd@debian.org>
  6. #
  7. # This program is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 2 of the License, or
  10. # (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. # GNU General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program; if not, write to the Free Software
  19. # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. # $Id: smtm.pl,v 1.122 2008/05/25 22:44:35 edd Exp $
  21. use strict; # be careful out there, my friend
  22. use English; # explicit variable names
  23. #use Data::Dumper; # FIXME
  24. use Date::Manip; # for date calculations
  25. use File::Spec; # portable filename operations
  26. use Finance::YahooQuote; # fetch quotes from Yahoo!
  27. use Getopt::Long; # parse command-line arguments
  28. use HTTP::Request::Common; # still needed to get charts
  29. use IO::File; # needed for new_tmpfile or Tk complains
  30. use POSIX qw(strftime); # strftime function
  31. use MIME::Base64; # to encode graphics directly for Photo widget
  32. use Text::ParseWords; # parse .csv files more reliably
  33. use Tk; # who needs gates in a world full o'windows?
  34. use Tk::Balloon; # widget for context-sensitive help
  35. use Tk::FileSelect; # widget for selecting files
  36. use Tk::PNG; # as of May 2005, Yahoo! send png charts
  37. use vars qw{%options %chart}; # need to define here for SUB {} below
  38. my # seperate for Makefile.PL
  39. $VERSION = "1.6.10"; # updated from the debian/rules Makefile
  40. my $date = # inner expression updated by RCS
  41. sprintf("%s", q$Date: 2008/05/25 22:44:35 $ =~ /\w*: (\d*\/\d*\/\d*)/);
  42. my (@Labels, # labels which carry the stock info
  43. @Buttons, # buttons which contain the labels,
  44. $BFrame, # frame containing the buttons
  45. $BFont, # font used for display on buttons + details
  46. $Header, # frame for column headings
  47. $headertext, # string for column headings display
  48. %coldisp, # hash of selected columns
  49. %Dat); # hash of hashes and lists for global data
  50. my $Main = new MainWindow; # create main window
  51. if ($OSNAME =~ m/MSWin32/) { # branch out for OS
  52. $Main->setPalette("gray95"); # light gray background
  53. $BFont = $Main->fontCreate(-family => 'courier', -size => 8);
  54. $ENV{HOME} = "C:/TEMP" unless $ENV{HOME};
  55. $ENV{TZ} = "GMT" unless $ENV{TZ}; # Date::Time needs timezone info
  56. } else {
  57. # $BFont = $Main->fontCreate(-family => 'lucidasanstypewriter', -size => 10);
  58. $BFont = $Main->fontCreate(-family => 'fixed', -size => 10);
  59. # $BFont = $Main->fontCreate(-family => 'courier', -size => 10);
  60. }
  61. # general options for user interface and behaviour, sort-of ugly global
  62. $options{file} = File::Spec->catfile($ENV{HOME}, ".smtmrc"); #default rc file
  63. $options{sort} = 'n'; # sort by name
  64. $options{timeout} = 180; # default timeout used in LWP code
  65. $options{columns} = 'nrla'; # default colums: name,last, rel.chg, abs. chg
  66. $options{percent} = 0; # default to percentage display, not bps
  67. $options{paused} = 0; # default to not paused, i.e. update
  68. $options{delay} = 5; # wait this many minutes
  69. ($options{firewall}, $options{proxy}, $options{wide}) = (undef,undef,undef);
  70. # global hash for chart options
  71. $chart{length} = '1'; # one-year chart is default chart
  72. $chart{log_scale} = 1; # plot on logarithmic scale
  73. $chart{volume} = 1; # show volume on seperate pane
  74. $chart{size} = 'm'; # plot size, default small (m medium, l large)
  75. $chart{style} = 'l'; # plot type, line ('c' candle, 'b' for bar)
  76. $chart{ma} = (); # placeholder hash for mov.avg. options
  77. $chart{ema} = (); # placeholder hash for exp.mov.avg. options
  78. $chart{technical} = (); # placeholder hash for tech. analysis options
  79. $chart{bollinger} = 0; # show bollinger bands
  80. $chart{parabolic_sar} = 0; # show parabolic sar
  81. $chart{comparison} = ""; # compare to this symbol (eg stock)
  82. my $today = ParseDate("today"); # current time, date for return calculations
  83. my $symbolcounter = 0; # needed for several pos. in same stock
  84. my %commandline_options = ("file=s" => \$options{file},
  85. "time=i" => \$options{delay},
  86. "fwall:s" => \$options{firewall},
  87. "proxy=s" => \$options{proxy},
  88. "wide" => \$options{wide},
  89. "percent" => \$options{percent},
  90. "columns=s" => \$options{columns},
  91. "sort=s" => \$options{sort},
  92. "nookbutton"=> \$options{nookbutton},
  93. "timeout=i" => \$options{timeout},
  94. "chart=s" => \$chart{length},
  95. "gallery" => \$options{gallery},
  96. "verbose" => \$options{verbose},
  97. "help" => \$options{help});
  98. # exit with helpful message if unknown command-line option, or help request
  99. help_exit() if (!GetOptions(%commandline_options) or $options{help});
  100. if ($#ARGV==-1) { # if no argument given
  101. if (-f $options{file}) { # if file exists
  102. read_config(); # load from file
  103. init_data(undef); # this indirectly calls buttons()
  104. } else { # else use default penguin portfolio
  105. warn("No arguments given, and no file found. Using example portfolio.\n");
  106. init_data(("RY.TO::50::48:20000104",
  107. "C::50:USDCAD:50.50:20000103",
  108. "DBK.DE::50:EURCAD:86.5:20010102",
  109. "HSBA.L::50:GBPCAD:967.02:20010101"))
  110. }
  111. } else { # else
  112. init_data(@ARGV); # use the given arguments
  113. }
  114. MainLoop; # and launch event loop under X11
  115. #----- Functions ------------------------------------------------------------
  116. sub menus { # create the menus
  117. # copy selected colums from string into hash
  118. for my $i (0..length($options{columns})-1) {
  119. $coldisp{substr($options{columns}, $i, 1)} = 1;
  120. }
  121. $Main->optionAdd("*tearOff", "false");
  122. my $MF = $Main->Frame()->pack(-side => 'top',
  123. -anchor => 'n',
  124. -expand => 1,
  125. -fill => 'x');
  126. my @M;
  127. $M[0] = $MF->Menubutton(-text => 'File', -underline => 0,
  128. )->pack(-side => 'left');
  129. $M[0]->AddItems(["command"=> "~Open", -command => \&select_file_and_open],
  130. ["command"=> "~Save", -command => \&file_save],
  131. ["command"=> "Save ~As",-command => \&select_file_and_save],
  132. ["command"=> "E~xit", -command => sub { exit }]);
  133. $M[1] = $MF->Menubutton(-text => 'Edit', -underline => 0,
  134. )->pack(-side => 'left');
  135. $M[1]->AddItems(["command" => "~Add Stock", -command => \&add_stock]);
  136. $M[1]->AddItems(["command" => "~Delete Stock(s)", -command => \&del_stock]);
  137. my $CasX = $M[1]->cascade(-label => '~Columns');
  138. my %colbutton_text = ('s' => '~Symbol',
  139. 'n' => '~Name',
  140. 'l' => '~Last Price',
  141. 'a' => '~Absolute Change',
  142. 'r' => '~Relative Change',
  143. 'V' => '~Volume traded',
  144. 'p' => 'Position ~Change',
  145. 'v' => '~Position Value',
  146. 'h' => '~Holding Period',
  147. 'R' => 'Annual Re~turn',
  148. 'd' => '~Drawdown',
  149. 'e' => '~Earnings per Share',
  150. 'P' => 'P~rice Earnings Ratio',
  151. 'D' => 'Di~vidend Yield',
  152. 'm' => '~Market Captialization',
  153. 'f' => '~FilePosition'
  154. );
  155. foreach (qw/s n l a r V p v h R d e P D m f/) {
  156. $CasX->checkbutton(-label => $colbutton_text{$ARG},
  157. -variable => \$coldisp{$ARG},
  158. -command => \&update_display);
  159. }
  160. my $CasS = $M[1]->cascade(-label => '~Sort');
  161. my %sortbutton_text = ('n' => '~Name',
  162. 'r' => '~Relative Change',
  163. 'a' => '~Absolute Change',
  164. 'p' => 'Position ~Change',
  165. 'v' => '~Position Value',
  166. 'V' => '~Volume Traded',
  167. 'h' => '~Holding Period',
  168. 'R' => 'Annual Re~turn',
  169. 'd' => '~Drawdown',
  170. 'e' => '~Earnings per Share',
  171. 'P' => 'P~rice Earnings Ratio',
  172. 'D' => 'Di~vidend Yield',
  173. 'm' => '~Market Captialization',
  174. 'f' => '~FilePosition');
  175. foreach (qw/n r a p v V h R d e P D m f/) {
  176. $CasS->radiobutton(-label => $sortbutton_text{$ARG},
  177. -command => \&update_display,
  178. -variable => \$options{sort},
  179. -value => $ARG);
  180. }
  181. $M[1]->AddItems(["command" => "Change ~Update Delay",
  182. -command => \&chg_delay]);
  183. $M[1]->AddItems(["command" => "Update ~Now",
  184. -command => \&update_display_variables]);
  185. $M[1]->checkbutton(-label => "~Wide window title",
  186. -variable => \$options{wide},
  187. -command => \&update_display);
  188. $M[1]->checkbutton(-label => "~Percent instead of bps",
  189. -variable => \$options{percent},
  190. -command => \&update_display);
  191. $M[1]->checkbutton(-label => "Susp~end updates",
  192. -variable => \$options{paused});
  193. $M[2] = $MF->Menubutton(-text => 'Charts', -underline => 0,
  194. )->pack(-side => 'left');
  195. my $CasC = $M[2]->cascade(-label => "~Timeframe");
  196. my %radiobutton_text = ('t' => 'Weekly Thumbnail',
  197. 'b' => '~Intraday',
  198. 'w' => '~Weekly',
  199. '3' => '~Three months',
  200. '6' => '~Six months',
  201. '1' => '~One year',
  202. '2' => 'Two ~years',
  203. '5' => '~Five years',
  204. 'm' => '~Max years');
  205. foreach (qw/t b w 3 6 1 2 5 m/) {
  206. $CasC->radiobutton(-label => $radiobutton_text{$ARG},
  207. -variable => \$chart{length}, -value => $ARG);
  208. }
  209. my $CasPS = $M[2]->cascade(-label => "Plot ~Size");
  210. my %radiobutton_ps = ('s' => '~Small',
  211. 'm' => '~Medium',
  212. 'l' => '~Large');
  213. foreach (qw/s m l/) {
  214. $CasPS->radiobutton(-label => $radiobutton_ps{$ARG},
  215. -variable => \$chart{size}, -value => $ARG);
  216. }
  217. my $CasPT = $M[2]->cascade(-label => "Plot T~ype");
  218. my %radiobutton_pt = ('l' => '~Line chart',
  219. 'b' => '~Bar chart',
  220. 'c' => '~Candle chart');
  221. foreach (qw/l b c/) {
  222. $CasPT->radiobutton(-label => $radiobutton_pt{$ARG},
  223. -variable => \$chart{style}, -value => $ARG);
  224. }
  225. my $CasMA = $M[2]->cascade(-label => '~Moving Averages');
  226. my %mabutton_text = ('5' => '5 days',
  227. '10' => '10 days',
  228. '20' => '20 days',
  229. '50' => '50 days',
  230. '100' => '100 days',
  231. '200' => '200 days');
  232. foreach (qw/5 10 20 50 100 200/) {
  233. $CasMA->checkbutton(-label => $mabutton_text{$ARG},
  234. -variable => \$chart{ma}{$ARG});
  235. }
  236. my $CasEMA = $M[2]->cascade(-label => '~Exp. Moving Avg.');
  237. foreach (qw/5 10 20 50 100 200/) {
  238. $CasEMA->checkbutton(-label => $mabutton_text{$ARG},
  239. -variable => \$chart{ema}{$ARG});
  240. }
  241. my $CasTA = $M[2]->cascade(-label => 'Te~chnical Analysis');
  242. # see http://help.yahoo.com/help/us/fin/chart/chart-12.html
  243. my %ta_text = ('m26_12_9' => 'MACD (MA Conv./Divergence)',
  244. 'f14' => 'MFI (Money Flow)',
  245. 'p12' => 'ROC (Rate of Change)',
  246. 'r14' => 'RSI (Relative Strength Index)',
  247. 'ss' => 'Stochastic (slow)',
  248. 'fs' => 'Stochastic (fast)',
  249. 'w14' => 'Williams %R');
  250. foreach (sort {$ta_text{$a} cmp $ta_text{$b}} keys %ta_text) {
  251. $CasTA->checkbutton(-label => $ta_text{$ARG},
  252. -variable => \$chart{technical}{$ARG});
  253. }
  254. $M[2]->checkbutton(-label => "~Logarithmic scale",
  255. -variable => \$chart{log_scale});
  256. $M[2]->checkbutton(-label => "~Volume and its MA",
  257. -variable => \$chart{volume});
  258. $M[2]->checkbutton(-label => "~Bollinger Bands",
  259. -variable => \$chart{bollinger});
  260. $M[2]->checkbutton(-label => "~Parabolic SAR",
  261. -variable => \$chart{parabolic_sar});
  262. $M[2]->AddItems(["command" => "Enter ~Comparison Symbol(s)",
  263. -command => \&get_comparison_symbol]);
  264. $M[2]->checkbutton(-label => "Chart ~Gallery",
  265. -variable => \$options{gallery},
  266. -command => \&show_gallery);
  267. $M[3] = $MF->Menubutton(-text => 'Help', -underline => 0,
  268. )->pack(-side => 'right');
  269. $M[3]->AddItems(["command" => "~Manual", -command => \&help_about]);
  270. $M[3]->AddItems(["command" => "~License", -command => \&help_license]);
  271. $Main->configure(-title => "smtm"); # this will be overridden later
  272. $Main->resizable(0,0); # don't allow width or height resizing
  273. $Main->iconname("smtm");
  274. }
  275. sub buttons { # create all display buttons
  276. @{$Dat{NA}} = sort @{$Dat{Arg}};
  277. $Main->resizable(1,1);
  278. $BFrame->destroy() if Tk::Exists($BFrame);
  279. $BFrame = $Main->Frame()->pack(-side=>'top', -fill=>'x');
  280. $BFrame->Label->repeat($options{delay}*1000*60,
  281. \&update_display_variables);
  282. $Header->destroy() if Tk::Exists($Header);
  283. $Header = $BFrame->Label(-anchor => 'w',
  284. -font => $BFont,
  285. -borderwidth => 3,
  286. -relief => 'groove',
  287. -textvariable => \$headertext,
  288. )->pack(-side => 'top', -fill => 'x');
  289. my $balloon = $BFrame->Balloon();
  290. foreach (0..$#{$Dat{Arg}}) { # set up the buttons
  291. $Buttons[$ARG]->destroy() if Tk::Exists($Buttons[$ARG]);
  292. $Buttons[$ARG] = $BFrame->Button(-command => [\&show_details, $ARG],
  293. -font => $BFont,
  294. -relief => 'flat',
  295. -borderwidth => -4,
  296. -textvariable => \$Labels[$ARG]
  297. )->pack(-side => 'top',
  298. -fill => 'x');
  299. $Buttons[$ARG]->bind("<Button-2>", [\&edit_stock, $ARG]);
  300. $Buttons[$ARG]->bind("<Button-3>", [\&view_image, $ARG]);
  301. $balloon->attach($Buttons[$ARG],
  302. -balloonmsg => "Mouse-1 for details, " .
  303. "Mouse-2 to edit, ".
  304. "Mouse-3 for chart");
  305. }
  306. $Main->resizable(0,0);
  307. # are we dealing with firewalls, and do we need to get the info ?
  308. if (defined($options{firewall}) and
  309. ($options{firewall} eq "" or $options{firewall} !~ m/.*:.*/)) {
  310. get_firewall_id(); # need to get firewall account + password
  311. } else {
  312. update_display_variables(); # else populate those buttons
  313. }
  314. }
  315. sub sort_func { # sort shares for display
  316. my @a = split /;/, $a;
  317. my @b = split /;/, $b;
  318. if ($options{sort} eq 'r') { # do we sort by returns (relative change)
  319. my $achg = $Dat{Bps}{$a[0]} || 0;
  320. my $bchg = $Dat{Bps}{$b[0]} || 0;
  321. if (defined($achg) and defined($bchg)) {
  322. return $bchg <=> $achg # apply descending (!!) numerical comparison
  323. || $a[1] cmp $b[1] # with textual sort on names to break ties
  324. } else {
  325. return $a[1] cmp $b[1]; # or default to textual sort on names
  326. }
  327. } elsif ($options{sort} eq 'a') { # do we sort by absolute change
  328. return $b[5] <=> $a[5]
  329. || $a[1] cmp $b[1] # or default to textual sort on names
  330. } elsif ($options{sort} eq 'p') { # do we sort by profit/loss amount
  331. return $Dat{PLContr}{$b[0]} <=> $Dat{PLContr}{$a[0]}
  332. || $a[1] cmp $b[1] # or default to textual sort on names
  333. } elsif ($options{sort} eq 'v') { # do we sort by profit/loss amount
  334. return $Dat{Value}{$b[0]} <=> $Dat{Value}{$a[0]}
  335. || $a[1] cmp $b[1] # or default to textual sort on names
  336. } elsif ($options{sort} eq 'V') { # do we sort by volume traded
  337. return $b[7] <=> $a[7]
  338. || $a[1] cmp $b[1] # or default to textual sort on names
  339. } elsif ($options{sort} eq 'h') { # do we sort by days held
  340. return $Dat{DaysHeld}{$b[0]} <=> $Dat{DaysHeld}{$a[0]}
  341. || $a[1] cmp $b[1] # or default to textual sort on names
  342. } elsif ($options{sort} eq 'R') { # do we sort by annual return
  343. return $Dat{Return}{$b[0]} <=> $Dat{Return}{$a[0]}
  344. || $a[1] cmp $b[1] # or default to textual sort on names
  345. } elsif ($options{sort} eq 'd') { # sort by drawdown
  346. my $a = defined($Dat{Drawdown}{$a[0]}) ? $Dat{Drawdown}{$a[0]} : 0;
  347. my $b = defined($Dat{Drawdown}{$b[0]}) ? $Dat{Drawdown}{$b[0]} : 0;
  348. return $b <=> $a || $a[1] cmp $b[1] # or default to textual sort on names
  349. } elsif ($options{sort} eq 'e') {
  350. return $Dat{EPS}{$b[0]} <=> $Dat{EPS}{$a[0]}
  351. || $a[1] cmp $b[1] # or default to textual sort on names
  352. } elsif ($options{sort} eq 'P') {
  353. return $Dat{PE}{$b[0]} <=> $Dat{PE}{$a[0]}
  354. || $a[1] cmp $b[1] # or default to textual sort on names
  355. } elsif ($options{sort} eq 'D') {
  356. return $Dat{DivYield}{$b[0]} <=> $Dat{DivYield}{$a[0]}
  357. || $a[1] cmp $b[1] # or default to textual sort on names
  358. } elsif ($options{sort} eq 'm') {
  359. my $a = $Dat{MarketCap}{$a[0]} ne "N/A" ? $Dat{MarketCap}{$a[0]} : 0;
  360. my $b = $Dat{MarketCap}{$b[0]} ne "N/A" ? $Dat{MarketCap}{$b[0]} : 0;
  361. return $b <=> $a || $a[1] cmp $b[1] # or default to textual sort on names
  362. } elsif ($options{sort} eq 'f') { # ordered by file position
  363. return $Dat{ID}{$a[0]} <=> $Dat{ID}{$b[0]}
  364. } else { # alphabetical sort
  365. return $a[1] cmp $b[1];
  366. }
  367. }
  368. sub update_display_variables { # gather data, and update display strings
  369. if (not $options{paused}) {
  370. update_data(); # fetch the data from the public servers
  371. compute_positions(); # update position hashes
  372. update_display(); # and update the ticker display
  373. show_gallery() if $options{gallery};
  374. }
  375. }
  376. sub update_data { # gather data from Yahoo! servers
  377. $today = ParseDate("today"); # current time and date for return calculations
  378. my $count = 0; # count 'defined' elements in Dat{FXarr}
  379. foreach my $val ($Dat{FXarr}) { $count++ if defined($val)};
  380. if ($count > 0) { # if there are cross-currencies
  381. my $array = getquote(@{$Dat{FXarr}}); # get FX crosses
  382. foreach my $ra (@$array) {
  383. next unless $ra->[0];
  384. $ra->[0] =~ s/\=X//; # reduce back to pure cross symbol
  385. $Dat{FX}{uc $ra->[0]} = $ra->[2]; # and store value in FX hash
  386. }
  387. }
  388. undef $Dat{Data};
  389. # NA: name,symbol,price,last date (m/d/y),time,change,percent,volume,avg vol,
  390. # bid, ask, previous,open,day range,52 week range,eps,p/e,
  391. # div pay date,annual div amt, divyld, cap
  392. if (scalar(@{$Dat{NA}})>-1) { # if there are stocks for Yahoo! North America
  393. fill_with_dummies(@{$Dat{NA}});
  394. ## call just as the symbol, i.e. without the number key past ':'
  395. my @syms = map { (split(/:/, $ARG))[0]} @{$Dat{NA}};
  396. my $array = getquote(@syms); # get North American quotes
  397. my $i=0;
  398. foreach my $ra (@$array) {
  399. $ra->[0] = @{$Dat{NA}}[$i++]; # store with supplied symbol + key
  400. $Dat{Data}{uc $ra->[0]} = join(";", @$ra); # store all info
  401. }
  402. }
  403. }
  404. # As getquote() may return empty, we have to intialize the %Dat hash
  405. # so that later queries don't hit a void
  406. sub fill_with_dummies {
  407. my (@arr) = @_;
  408. foreach $ARG (@arr) {
  409. $Dat{Data}{uc $ARG} = join(";", (uc $ARG, "-- N/A --",
  410. 0, "1/1/1970", "00:00", 0, "0.00%",
  411. 0, "-", "-", "-", "-", "-",
  412. "-", "-", "-", "-", "-", "-", "-"));
  413. }
  414. }
  415. # Use the name supplied from Yahoo!, unless there is a user-supplied
  416. # GivenName in the rc file. In case we have data problems, return N/A
  417. sub get_pretty_name {
  418. my ($pretty, $default) = @_;
  419. if (not defined($pretty) or $pretty eq "" or $default eq "-- N/A --") {
  420. return $default;
  421. } else {
  422. return $pretty;
  423. }
  424. }
  425. sub compute_positions {
  426. undef %{$Dat{Price}};
  427. undef %{$Dat{Change}};
  428. undef %{$Dat{Bps}};
  429. undef %{$Dat{PLContr}};
  430. undef %{$Dat{Value}};
  431. undef %{$Dat{Volume}};
  432. undef %{$Dat{Return}};
  433. undef %{$Dat{DaysHeld}};
  434. # We have to loop through once to compute all column entries, and to store
  435. # them so that we can find the largest each to compute optimal col. width
  436. foreach (values %{$Dat{Data}}) {
  437. my @arr = split (';', $ARG);
  438. my $symbol = uc $arr[0];
  439. $Dat{Name}{$symbol} = $arr[1] || "-- No connection";
  440. $Dat{Price}{$symbol} = $arr[2] || 0;
  441. $Dat{Change}{$symbol} = $arr[5] || 0;
  442. $Dat{Change}{$symbol} = 0 if $Dat{Change}{$symbol} eq "N/A";
  443. my $pc = $arr[6] || "0.00%";
  444. $pc =~ s/\%//; # extract percent change
  445. $pc = 0 if $pc eq "N/A";
  446. my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
  447. my $shares = $Dat{Shares}{$symbol} || 0;
  448. $Dat{Bps}{$symbol} = 100*$pc * ($shares < 0 ? -1 : 1);
  449. my $plcontr = $shares * $Dat{Change}{$symbol} * $fx;
  450. $Dat{PLContr}{$symbol} = $plcontr;
  451. my $value = $shares * $Dat{Price}{$symbol} * $fx;
  452. $Dat{Value}{$symbol} = $value;
  453. $Dat{Volume}{$symbol} = $arr[7] || 0;
  454. ($Dat{YearLow}{$symbol}, $Dat{YearHigh}{$symbol}) = (undef, undef);
  455. ($Dat{YearLow}{$symbol}, $Dat{YearHigh}{$symbol}) = split / - /, $arr[14];
  456. if (defined($Dat{YearHigh}{$symbol})
  457. and $Dat{YearHigh}{$symbol} ne "N/A"
  458. and $Dat{YearHigh}{$symbol} != 0) {
  459. $Dat{Drawdown}{$symbol}
  460. = 100.0*($Dat{Price}{$symbol}/$Dat{YearHigh}{$symbol}-1.0);
  461. } else {
  462. $Dat{Drawdown}{$symbol} = undef;
  463. }
  464. if ($Dat{PurchPrice}{$symbol} and $Dat{PurchDate}{$symbol}) {
  465. $Dat{DaysHeld}{$symbol} =
  466. Delta_Format(DateCalc($Dat{PurchDate}{$symbol},
  467. $today, undef, 2), 0, "%dt");
  468. if ( $Dat{DaysHeld}{$symbol} > 365 ) {
  469. $Dat{Return}{$symbol} = ($Dat{Price}{$symbol} /
  470. $Dat{PurchPrice}{$symbol} - 1) * 100
  471. * 365 / $Dat{DaysHeld}{$symbol}
  472. * ($shares < 0 ? -1 : 1);
  473. } else { # don't annualize
  474. $Dat{Return}{$symbol} = ($Dat{Price}{$symbol} /
  475. $Dat{PurchPrice}{$symbol} - 1) * 100
  476. * ($shares < 0 ? -1 : 1);
  477. }
  478. } else {
  479. $Dat{DaysHeld}{$symbol} = undef;
  480. $Dat{Return}{$symbol} = undef;
  481. }
  482. $Dat{EPS}{$symbol} = $arr[15] || 0;
  483. $Dat{PE}{$symbol} = $arr[16] || 0;
  484. $Dat{DivDate}{$symbol} = $arr[17] || 0;
  485. $Dat{DivAmount}{$symbol} = $arr[18] || 0;
  486. $Dat{DivYield}{$symbol} = $arr[19] || 0;
  487. $Dat{MarketCap}{$symbol} = "N/A"; # default to NA
  488. if (defined($arr[20]) and # need to regularise oddball market string
  489. $arr[20] ne "N/A") {
  490. # before the dot, the dot, first decimal, remaining decimal, units
  491. my ($pre,$p1,$p2,$s) = ($arr[20] =~ m/(\d*)\.(\d)(\d*)(B|M|K)$/);
  492. #print "$arr[20] -> $pre DOT $p1 $p2 $s\n";
  493. $Dat{MarketCap}{$symbol} = "$pre" . "." . $p1 . $s
  494. if defined($p1) and defined($s);
  495. }
  496. foreach ("EPS","PE", "DivYield") {
  497. $Dat{$ARG}{$symbol} = 0 if $Dat{$ARG}{$symbol} eq "N/A";
  498. }
  499. }
  500. }
  501. sub update_display {
  502. my $pl = 0; # profit/loss counter
  503. my $nw = 0; # networth counter
  504. my $shares = 0; # net shares positions
  505. my $max_sym = 0;
  506. foreach my $key (keys %{$Dat{Symbol}}) {
  507. $max_sym = length($key) if (length($key) > $max_sym);
  508. }
  509. my $max_len = 0;
  510. foreach my $key (keys %{$Dat{Name}}) {
  511. my $txt = get_pretty_name($Dat{GivenName}{$key}, $Dat{Name}{$key})
  512. || "-- No connection";
  513. $txt =~ s/\s*$//; # eat trailing white space, if any
  514. my $len = length($txt) > 16 ? 16 : length($txt);
  515. $max_len = $len if ($len > $max_len);
  516. }
  517. my $max_price = 0;
  518. foreach my $val (values %{$Dat{Price}}) {
  519. $max_price = $val if ($val > $max_price);
  520. }
  521. my $max_change = 0.01; # can't take log of zero below
  522. my $min_change = 0.01;
  523. foreach my $val (values %{$Dat{Change}}) {
  524. $max_change = $val if ($val > $max_change);
  525. $min_change = $val if ($val < $min_change);
  526. }
  527. my $max_bps = 1; # can't take log of zero below
  528. my $min_bps = 1;
  529. foreach my $val (values %{$Dat{Bps}}) {
  530. $max_bps = $val if ($val > $max_bps);
  531. $min_bps = $val if ($val < $min_bps);
  532. }
  533. my $max_plc = 1; # can't take log of zero below
  534. my $min_plc = 1;
  535. foreach my $val (values %{$Dat{PLContr}}) {
  536. $max_plc = $val if ($val > $max_plc);
  537. $min_plc = $val if ($val < $min_plc);
  538. }
  539. my $max_value = 1; # can't take log of zero below
  540. foreach my $val (values %{$Dat{Value}}) {
  541. $max_value = $val if ($val > $max_value);
  542. }
  543. my $max_volume = 1; # can't take log of zero below
  544. foreach my $val (values %{$Dat{Volume}}) {
  545. $max_volume = $val if (($val ne "N/A") and ($val > $max_volume));
  546. }
  547. my $max_held = 0; #
  548. foreach my $val (values %{$Dat{DaysHeld}}) {
  549. $max_held = $val if (defined($val) and $val > $max_held);
  550. }
  551. my $max_ret = 0; #
  552. my $min_ret = 0; #
  553. foreach my $val (values %{$Dat{Return}}) {
  554. $max_ret = $val if (defined($val) and $val > $max_ret);
  555. $min_ret = $val if (defined($val) and $val < $min_ret);
  556. }
  557. my $max_ddown = 0;
  558. foreach my $val (values %{$Dat{Drawdown}}) {
  559. $max_ddown = $val if (defined($val) and $val < $max_ddown);
  560. }
  561. my $max_eps = 0;
  562. my $min_eps = 0; #
  563. foreach my $val (values %{$Dat{EPS}}) {
  564. $max_eps = $val if (defined($val) and $val ne "-"
  565. and $val ne "N/A" and $val > $max_eps);
  566. $min_eps = $val if (defined($val) and $val ne "-"
  567. and $val ne "N/A" and $val < $min_eps);
  568. }
  569. my $max_pe = 0;
  570. foreach my $val (values %{$Dat{PE}}) {
  571. $max_pe = $val if (defined($val) and $val ne "-"
  572. and $val ne "N/A" and $val > $max_pe);
  573. }
  574. my $max_divyld = 0;
  575. foreach my $val (values %{$Dat{DivYield}}) {
  576. $max_divyld = $val if (defined($val) and $val ne "-" and $val ne "N/A"
  577. and $val > $max_divyld);
  578. }
  579. my $max_mktcap = 0;
  580. foreach my $val (values %{$Dat{MarketCap}}) {
  581. my $nval = $val;
  582. $nval =~ s/(B|M|K)$//;
  583. $max_mktcap = $nval if (defined($nval) and $nval ne "N/A"
  584. and $nval ne "-" and $nval > $max_mktcap);
  585. }
  586. my $max_fpos = 0;
  587. foreach my $val (values %{$Dat{ID}}) {
  588. $max_fpos = $val if (defined($val) and $val > $max_fpos);
  589. }
  590. # transform as necessary
  591. $max_price = 3 + digits($max_price); # dot and two digits
  592. $max_change = 3 + max(digits($max_change), digits($min_change));
  593. $max_bps = max(3+$options{percent}, max(digits($max_bps),digits($min_bps)));
  594. $max_plc = max(3, max(digits($max_plc),digits($min_plc)));
  595. $max_value = max(3, digits($max_value));
  596. $max_volume = digits($max_volume);
  597. $max_ret = 2 + max(digits($max_ret),digits($min_ret));
  598. $max_held = max(3, digits($max_held));
  599. $max_ddown = 2 + max(2, 1+digits(-$max_ddown)); # 1 decimals,dot,minus,digitb
  600. $max_eps = 2 + max(digits($max_eps),digits($min_eps));
  601. $max_pe = 2 + digits($max_pe);
  602. $max_divyld = 2 + digits($max_divyld);
  603. $max_mktcap = 3 + digits($max_mktcap);
  604. $max_fpos = max(2, digits($max_fpos));
  605. $headertext = "";
  606. $headertext .= "Sym " . " " x ($max_sym-3) if $coldisp{s};
  607. $headertext .= "Name " . " " x ($max_len-4) if $coldisp{n};
  608. # $headertext .= " "; # transition from leftflush to rightflush
  609. $headertext .= " " x ($max_price-4) . "Last " if $coldisp{l};
  610. $headertext .= " " x ($max_change-3) . "Chg " if $coldisp{a};
  611. $headertext .= " " x ($max_bps-4) . "%Chg "
  612. if $coldisp{r} and $options{percent};
  613. $headertext .= " " x ($max_bps-3) . "Bps "
  614. if $coldisp{r} and not $options{percent};
  615. $headertext .= " " x ($max_volume-3) . "Vol " if $coldisp{V};
  616. $headertext .= " " x ($max_plc-3) . "P/L " if $coldisp{p};
  617. $headertext .= " " x ($max_value-3) . "Net " if $coldisp{v};
  618. $headertext .= " " x ($max_held-3) . "Len " if $coldisp{h};
  619. $headertext .= " " x ($max_ret-3) . "Ret " if $coldisp{R};
  620. $headertext .= " " x ($max_ddown - 4) . "Ddwn " if $coldisp{d};
  621. $headertext .= " " x ($max_eps - 3) . "EPS " if $coldisp{e};
  622. $headertext .= " " x ($max_pe - 2) . "PE " if $coldisp{P};
  623. $headertext .= " " x ($max_divyld - 3) . "Yld " if $coldisp{D};
  624. $headertext .= " " x ($max_mktcap - 3) . "Cap " if $coldisp{m};
  625. $headertext .= "FP " if $coldisp{f};
  626. chop $headertext; # get trailing ' '
  627. print "$headertext\n" if $options{verbose};
  628. # Now apply all that information to the display
  629. my $i = 0;
  630. foreach (sort sort_func values %{$Dat{Data}}) {
  631. my @arr = split (';', $ARG);
  632. my $symbol = uc $arr[0];
  633. my $name = get_pretty_name($Dat{GivenName}{$symbol},
  634. $Dat{Name}{$symbol}) || "-- No connection";
  635. if (not defined $Dat{Bps}{$symbol}) {
  636. $Buttons[$i]->configure(-foreground => 'white',
  637. -activeforeground => 'white');
  638. } elsif ($Dat{Bps}{$symbol} < 0) { # if we're losing money on this one
  639. $Buttons[$i]->configure(-foreground => 'red',
  640. -activeforeground => 'red');
  641. } else {
  642. $Buttons[$i]->configure(-foreground => 'black',
  643. -activeforeground => 'black');
  644. }
  645. $Labels[$i] = "";
  646. $Labels[$i] .= sprintf("%*s ", -$max_sym, $Dat{Symbol}{$symbol})
  647. if $coldisp{s};
  648. $Labels[$i] .= sprintf("%*s ", -$max_len, substr($name,0,$max_len))
  649. if $coldisp{n};
  650. $Labels[$i] .= sprintf("%$max_price.2f ", $Dat{Price}{$symbol})
  651. if $coldisp{l};
  652. $Labels[$i] .= sprintf("%$max_change.2f ", $Dat{Change}{$symbol})
  653. if $coldisp{a};
  654. $Labels[$i] .= sprintf("%$max_bps.0f ", $Dat{Bps}{$symbol})
  655. if $coldisp{r} and not $options{percent};
  656. $Labels[$i] .= sprintf("%" . ($max_bps + 1) . ".2f ",
  657. ($Dat{Bps}{$symbol}) / 100)
  658. if $coldisp{r} and $options{percent};
  659. $Labels[$i] .= sprintf("%$max_volume.0d ",
  660. ($Dat{Volume}{$symbol} ne "N/A"
  661. ? $Dat{Volume}{$symbol} : 0))
  662. if $coldisp{V};
  663. $Labels[$i] .= sprintf("%$max_plc.0f ", $Dat{PLContr}{$symbol})
  664. if $coldisp{p};
  665. $Labels[$i] .= sprintf("%$max_value.0f ", $Dat{Value}{$symbol})
  666. if $coldisp{v};
  667. if ($coldisp{h}) {
  668. if (defined($Dat{DaysHeld}{$symbol})) {
  669. $Labels[$i] .= sprintf("%$max_held.0f ", $Dat{DaysHeld}{$symbol});
  670. } else {
  671. $Labels[$i] .= sprintf("%*s ", $max_held, "NA");
  672. }
  673. }
  674. if ($coldisp{R}) {
  675. if (defined($Dat{Return}{$symbol})) {
  676. $Labels[$i] .= sprintf("%$max_ret.1f ", $Dat{Return}{$symbol});
  677. } else {
  678. $Labels[$i] .= sprintf("%*s ", $max_ret, "NA");
  679. }
  680. }
  681. if ($coldisp{d}) { # drawdown
  682. if (defined($Dat{Drawdown}{$symbol})) {
  683. $Labels[$i] .= sprintf("%$max_ddown.1f ", $Dat{Drawdown}{$symbol});
  684. } else {
  685. $Labels[$i] .= sprintf("%*s ", $max_ddown, "NA");
  686. }
  687. }
  688. $Labels[$i] .= sprintf("%$max_eps.1f ", $Dat{EPS}{$symbol})
  689. if $coldisp{e};
  690. $Labels[$i] .= sprintf("%$max_pe.1f ", $Dat{PE}{$symbol})
  691. if $coldisp{P};
  692. $Labels[$i] .= sprintf("%$max_divyld.1f ", $Dat{DivYield}{$symbol})
  693. if $coldisp{D};
  694. if ($coldisp{m}) {
  695. if ($Dat{MarketCap}{$symbol} ne "N/A") {
  696. $Labels[$i] .= sprintf("%*s ", $max_mktcap, $Dat{MarketCap}{$symbol});
  697. } else {
  698. $Labels[$i] .= sprintf("%*s ", $max_mktcap, "NA");
  699. }
  700. }
  701. $Labels[$i] .= sprintf("%$max_fpos.0f ", $Dat{ID}{$symbol})
  702. if $coldisp{f};
  703. chop $Labels[$i];
  704. print "$Labels[$i]\n" if $options{verbose};
  705. $nw += $Dat{Value}{$symbol};
  706. $pl += $Dat{PLContr}{$symbol};
  707. $Dat{Map}[$i++] = $symbol;
  708. }
  709. my $bps = $nw - $pl != 0 ? 100*100*($pl/($nw-$pl)) : 0;
  710. my $txt = ($options{percent} ?
  711. sprintf("%.2f%%", $bps / 100) : sprintf("%.0f Bps", $bps))
  712. . " at " . POSIX::strftime("%H:%M", localtime);
  713. $txt = $txt . sprintf(" p/l %.0f net %.0f", $pl, $nw) if ($options{wide});
  714. $Main->configure(-title => $txt);
  715. $Main->iconname($txt); # also set the icon name
  716. }
  717. sub digits { # calculate nb of digits sprintf will need
  718. my $x = shift;
  719. my $count = 0;
  720. $count = $x =~ s/[BKM]$//;
  721. # rounded(log10(0.5) gives 0 even though this has 1 leading decimal
  722. $x *= 10 if (abs($x) > 0 and abs($x) < 1);
  723. $x *= 10 if ($x<0); # add one for minus sign
  724. $x = abs($x) if ($x < 0); # need absolute value of neg. values
  725. if ($x != 0) {
  726. return int(log($x)/log(10)+1) + $count;# this gives the rounded log10 of x
  727. } else {
  728. return 1;
  729. }
  730. }
  731. sub max {
  732. my ($a,$b) = @_;
  733. $a > $b ? return $a : $b;
  734. }
  735. sub show_details { # display per-share details
  736. my $key = shift;
  737. my $TL = $Main->Toplevel; # new toplevel widget ...
  738. $TL->resizable(0,0); # no resizing
  739. my (@text) = ("Symbol", "Name", "Price", "Date", "Time", "Change",
  740. "Percent. Change", "Volume", "Average Volume",
  741. "Bid", "Ask", "Previous", "Open", "Day Range",
  742. "52 Week Range", "Earnings/Share", "Price/Earnings",
  743. "Dividend Date", "Dividend Amount", "Dividend Yield",
  744. "Market Capital");
  745. my $Text = $TL->Text(-height => 1 + $#text + 7, # 7 computed position values
  746. -width => 39,
  747. -font => $BFont,
  748. )->pack();
  749. my @arr = split (';', $Dat{Data}{ $Dat{Map}[$key] });
  750. my $symbol = $arr[0];
  751. $arr[0] = $Dat{Symbol}{$arr[0]};
  752. $arr[1] = substr(get_pretty_name($Dat{GivenName}{$symbol},
  753. $Dat{Name}{$symbol}) || "-- No connection",
  754. 0, 22);
  755. $TL->title("Details for $arr[1]");
  756. foreach (0..$#text) {
  757. $Text->insert('end', sprintf("%-16s %s\n", $text[$ARG], $arr[$ARG]));
  758. }
  759. my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
  760. my $shares = $Dat{Shares}{$symbol} || 0;
  761. $Text->insert('end',
  762. sprintf("%-16s %d\n%-16s %.2f\n%-16s %.2f\n",
  763. "Shares Held", $shares,
  764. "Value Change", $shares * $Dat{Change}{$symbol} * $fx,
  765. "Total Value", $shares * $Dat{Price}{$symbol} * $fx));
  766. $Text->insert('end', sprintf("%-16s %s\n", "Days Held",
  767. defined($Dat{DaysHeld}{$symbol}) ?
  768. sprintf("%d years and %d days",
  769. $Dat{DaysHeld}{$symbol}/365,
  770. $Dat{DaysHeld}{$symbol} % 365) : "NA"));
  771. $Text->insert('end', sprintf("%-16s %s\n", "Purchase Price",
  772. $Dat{PurchPrice}{$symbol} ?
  773. sprintf("%.2f",$Dat{PurchPrice}{$symbol}) : "NA"));
  774. if ( $shares != 0 ) {
  775. my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
  776. my $gl = ($Dat{Price}{$symbol} - $Dat{PurchPrice}{$symbol})
  777. * ($shares < 0 ? -1 : 1) * $fx;
  778. $Text->insert('end', sprintf("%-16s %s\n", "Profit or Loss",
  779. sprintf("%.2f", $gl * $shares)));
  780. } else {
  781. $Text->insert('end', sprintf("%-16s %s\n", "Profit or Loss", "NA"));
  782. }
  783. if ( defined($Dat{Return}{$symbol}) && $Dat{DaysHeld}{$symbol} > 365 ) {
  784. $Text->insert('end', sprintf("%-16s %s\n", "Annual. Return",
  785. defined($Dat{Return}{$symbol}) ?
  786. sprintf("%.2f%%",
  787. $Dat{Return}{$symbol}) : "NA"));
  788. } else {
  789. $Text->insert('end', sprintf("%-16s %s\n", "YTD Return",
  790. defined($Dat{Return}{$symbol}) ?
  791. sprintf("%.2f%%",
  792. $Dat{Return}{$symbol}) : "NA"));
  793. }
  794. button_or_mouseclick_close($TL,$Text);
  795. }
  796. sub button_or_mouseclick_close {
  797. my ($A,$B) = @_;
  798. if ($options{nookbutton}) {
  799. $B->bind("<Button-1>", sub { $A->destroy}); # also close on Button-1
  800. } else {
  801. $A->Button(-text => 'Ok',
  802. -command => sub { $A->destroy(); } )->pack(-side => 'bottom');
  803. }
  804. }
  805. sub add_image_close_button($$) {
  806. my ($arg, $new) = @_;
  807. if ($options{nookbutton}) {
  808. $Dat{Label}[$arg]->bind("<Button-1>",
  809. sub {
  810. $Dat{Image}[$arg]->delete;
  811. $Dat{Chart}[$arg]->destroy();
  812. delete $Dat{Chart}[$arg]
  813. or die "Cannot delete chart\n";
  814. delete $Dat{Image}[$arg]
  815. or die "Cannot delete image\n";
  816. delete $Dat{Label}[$arg]
  817. or die "Cannot delete label\n";
  818. });
  819. } elsif ($new) {
  820. $Dat{Chart}[$arg]->Button(-text => 'Ok',
  821. -command => sub {
  822. $Dat{Image}[$arg]->delete;
  823. $Dat{Chart}[$arg]->destroy();
  824. delete $Dat{Chart}[$arg]
  825. or die "Cannot delete chart\n";
  826. delete $Dat{Image}[$arg]
  827. or die "Cannot delete image\n";
  828. delete $Dat{Label}[$arg]
  829. or die "Cannot delete label\n";
  830. },
  831. )->pack(-side => 'bottom')
  832. or die "Cannot create button\n";
  833. }
  834. }
  835. sub view_image {
  836. my ($widget,$arg) = @_;
  837. my @arr = split (';', $Dat{Data}{ $Dat{Map}[$arg] });
  838. my $url = charturl(lc( $Dat{Symbol}{$arr[0]} ));
  839. my $ua = LWP::UserAgent->new;
  840. $ua->env_proxy;
  841. $ua->proxy('http', $options{proxy}) if $options{proxy};
  842. $ua->timeout($options{timeout}); # time out after this many secs
  843. my $resp = $ua->request(GET $url);
  844. if ($resp->is_error) { # error in retrieving the chart;
  845. my $new = 0; # by default we renew
  846. my ($TL, $PH);
  847. if (!exists($Dat{Chart}[$arg])) {
  848. $Dat{Chart}[$arg] = $Main->Toplevel; # new toplevel widget ...
  849. $new = 1; # remember that this is a first
  850. }
  851. $TL = $Dat{Chart}[$arg]; # most likely 404 (not found);
  852. #$TL->resizable(0,0); # no resizing
  853. $TL->title ("Error"); # Yahoo returns HTML, not a NULL,
  854. $Dat{Chart}[$arg] = $TL; # store for later update
  855. my $Text = $TL->Label(-padx =>5, # so need to check return code
  856. -pady =>5,
  857. -text =>"The chart for $arr[1] is not available."
  858. )->pack;
  859. $Dat{Label}[$arg] = $Text; # store the label
  860. $Dat{Photo}[$arg] = "placeholder"; # and an image placeholder
  861. add_image_close_button($arg, $new);
  862. } else {
  863. my $new = 0; # by default we renew
  864. my ($TL, $PH);
  865. if (!exists($Dat{Chart}[$arg])) {
  866. $Dat{Chart}[$arg] = $Main->Toplevel; # new toplevel widget ...
  867. $new = 1; # remember that this is a first
  868. }
  869. ## test if Tk object still Exists as users may have killed it
  870. if (defined($Dat{Chart}[$arg]) and Exists($Dat{Chart}[$arg])) {
  871. $Dat{Chart}[$arg]->title("Graph for $arr[1] at " .
  872. POSIX::strftime("%H:%M", localtime));
  873. $TL = $Dat{Chart}[$arg];
  874. #$TL->resizable(0,0); # no resizing
  875. if (exists($Dat{Image}[$arg])) { # if we have a previous image
  876. $Dat{Image}[$arg]->delete; # delete it (to reclaim memory)
  877. }
  878. ## can pass the web-request response to Photo widget once base64 encoded
  879. $Dat{Image}[$arg] = $TL->Photo(-data => encode_base64($resp->content),
  880. ## as of May 2005, png is used -format => "gif");
  881. -format => "png");
  882. $PH = $Dat{Image}[$arg];
  883. if (exists($Dat{Label}[$arg])) { # if we have a previous label
  884. $Dat{Label}[$arg]->destroy(); # destroy it (to make new one visible)
  885. }
  886. $Dat{Label}[$arg] = $TL->Label(-image => $PH)->pack();
  887. ##
  888. add_image_close_button($arg, $new);
  889. }
  890. }
  891. }
  892. sub charturl { # initially (almost) verbatim from Dj's
  893. my $symbol = shift; # YahooChart, now completely rewritten
  894. my $url; # and very significantly extended
  895. my $len = $chart{length};
  896. if ($len =~ m/t/o) { # if 'm' for thumbnail
  897. $url = "http://ichart.yahoo.com/v?s=$symbol"; ## really small
  898. } elsif ($len =~ m/(b|w)/o) { # if 'b' or 'w' for intra-day or 5 day
  899. ## next line no longer needed, IIRC we once used i for what we now use b
  900. ##$len = 'b' if $len eq 'i'; # intraday chart uses Yahoo! code 'b'
  901. $url = "http://ichart.yahoo.com/$len?s=$symbol";
  902. #$url = "http://ichart.yahoo.com/v?s=$symbol"; ## really small
  903. } else { # everything else, ie three month onwards
  904. $len .= 'y' if $len=~ m/(1|2|5|m)/o;# code for year is '1y' ... 'my'
  905. $len .= 'm' if $len =~ m/(3|6)/o; # code for month is '3m' or '6m'
  906. my $params = "s"; # always set splits
  907. foreach (keys %{$chart{ma}}) { # for all possible moving avg options
  908. $params .= ",m$ARG" if $chart{ma}{$ARG};
  909. }
  910. foreach (keys %{$chart{ema}}){ # for all possible exp. mov avg options
  911. $params .= ",e$ARG" if $chart{ema}{$ARG};
  912. }
  913. $params .= ",b" if $chart{bollinger}; # maybe set Bollinger Bands
  914. $params .= ",p" if $chart{parabolic_sar}; # maybe set Parabolic SAR
  915. my $log = $chart{log_scale} ? "on" : "off"; # maybe switch to log scale
  916. my $pane = $chart{volume} ? "vm" : ""; # maybe add volume on new pane
  917. foreach (keys %{$chart{technical}}) { # for all tech. analysis opt.
  918. $pane .= ",$ARG" if $chart{technical}{$ARG};# add on new pane if selected
  919. }
  920. #$url = "http://cchart.yimg.com/z?" .
  921. $url = "http://ichart.yimg.com/z?" .
  922. "&s=$symbol&p=$params&t=$len&c=$chart{comparison}" .
  923. "&l=$log&z=$chart{size}&q=$chart{style}&a=$pane";
  924. }
  925. print "URL $url\n" if $options{verbose};
  926. return $url;
  927. }
  928. sub default_directory {
  929. my $directory = File::Spec->catfile($ENV{HOME}, ".smtm");
  930. unless (-d $directory) {
  931. warn("Default directory $directory not found, creating it.\n");
  932. mkdir($directory, 0750) or die "Could not create $directory: $!";
  933. }
  934. return $directory;
  935. }
  936. sub select_file_and_open {
  937. my $selfile = $Main->getOpenFile(-defaultextension => ".smtm",
  938. -initialdir => default_directory(),
  939. -filetypes => [
  940. ['SMTM', '.smtm' ],
  941. ['All Files', '*',],
  942. ],
  943. -title => "Load an SMTM file");
  944. if (defined($selfile)) { # if user has hit Accept, do nothing on Cancel
  945. $options{file} = $selfile;
  946. read_config();
  947. init_fx();
  948. buttons();
  949. }
  950. }
  951. sub select_file_and_save {
  952. my $selfile = $Main->getSaveFile(-defaultextension => ".smtm",
  953. -initialdir => default_directory(),
  954. -title => "Save an SMTM file");
  955. if (defined($selfile)) { # if user has hit Accept, do nothing on Cancel
  956. $options{file} = $selfile;
  957. file_save();
  958. }
  959. }
  960. sub read_config { # get the data from the resource file
  961. undef $Dat{ID}; # make sure we delete the old symbols, if any
  962. undef $Dat{Arg}; # make sure we delete the old symbols, if any
  963. undef $Dat{Map}; # make sure we delete the old symbols, if any
  964. undef $Dat{Name}; # make sure we delete the old symbols, if any
  965. undef $Dat{Symbol}; # make sure we delete the old symbols, if any
  966. undef $Dat{GivenName}; # make sure we delete the old symbols, if any
  967. undef $Dat{Shares}; # make sure we delete the old symbols, if any
  968. undef $Dat{Cross}; # make sure we delete the old symbols, if any
  969. undef $Dat{PurchPrice}; # make sure we delete the old symbols, if any
  970. undef $Dat{PurchDate}; # make sure we delete the old symbols, if any
  971. open (FILE, "<$options{file}") or die "Cannot open $options{file}: $!\n";
  972. while (<FILE>) { # loop over all lines in the file
  973. next if (m/(\#|%)/); # ignore comments, if any
  974. next if (m/^\s*$/); # ignore empty lines, if any
  975. next if (m/.*=$/); # ignore non-assignments
  976. if (m/^\s*\$?(\S+)=(\S+)\s*$/) { # if assignment, then it must be an option
  977. my ($arg,$val) = ($1,$2);
  978. if ($val =~ m/^X:/) { # currency symbol like GBPEUR=X
  979. insert_stock($ARG);
  980. } elsif ($arg eq "retsort") { # test for one legacy option
  981. $options{sort}='r' if $val; # old option $retsort was always = 1
  982. } elsif ($arg =~ m/chart::(\w*)/){# test for chart option
  983. my $key = $1;
  984. warn "No chart option $key known\n" unless exists($chart{$key});
  985. if (index($val, ":") > -1) {
  986. foreach (split /:/, $val) {
  987. my $cmd = "\$chart{$key}{$ARG}=1\n";
  988. print "Setting from rcfile: $cmd" if $options{verbose};
  989. eval $cmd; # store option
  990. }
  991. } else {
  992. my $cmd = "\$chart{$key}='$val'\n";
  993. print "Setting from rcfile: $cmd" if $options{verbose};
  994. eval $cmd; # store option
  995. }
  996. } else { # else normal option
  997. warn "No option $arg known\n" unless exists($options{$arg});
  998. my $cmd = "\$options{$arg}='$val'\n";
  999. print "Setting from rcfile: $cmd" if $options{verbose};
  1000. eval $cmd; # store option
  1001. }
  1002. } else { # or else it is stock information
  1003. insert_stock($ARG);
  1004. }
  1005. }
  1006. close(FILE);
  1007. for my $i (0..length($options{columns})-1) {
  1008. $coldisp{substr($options{columns}, $i, 1)} = 1;
  1009. }
  1010. }
  1011. sub insert_stock { # insert one stock into main data structure
  1012. my $arg = shift;
  1013. chomp $arg;
  1014. my @arr = split ':', $arg; # split along ':'
  1015. $arr[0] = uc $arr[0]; # uppercase the symbol
  1016. my $key = $arr[0] . ':' . $symbolcounter++;
  1017. push @{$Dat{Arg}}, $key; # store symbol
  1018. $Dat{ID}{$key} = $symbolcounter;
  1019. $Dat{Symbol}{$key} = defined($arr[0]) ? $arr[0] : "";
  1020. $Dat{GivenName}{$key} = defined($arr[1]) ? $arr[1] : "";
  1021. $Dat{Shares}{$key} = defined($arr[2]) ? $arr[2] : 0;
  1022. $Dat{Cross}{$key} = defined($arr[3]) ? $arr[3] : "";
  1023. $Dat{PurchPrice}{$key} = defined($arr[4]) ? $arr[4] : 0;
  1024. $Dat{PurchDate}{$key} = defined($arr[5]) ? $arr[5] : 0;
  1025. }
  1026. sub edit_stock {
  1027. my ($widget,$arg) = @_;
  1028. my $key = $Dat{Map}[$arg];
  1029. my $TL = $Main->Toplevel; # new toplevel widget ...
  1030. $TL->title ("Edit Stock");
  1031. $TL->resizable(0,0); # no resizing
  1032. my $FR = $TL->Frame->pack(-fill => 'both', -fill => 'x');
  1033. my $row = 0;
  1034. my @data = ( $Dat{Symbol}{$key},
  1035. $Dat{GivenName}{$key} || $Dat{Name}{$key},
  1036. $Dat{Shares}{$key},
  1037. $Dat{Cross}{$key},
  1038. $Dat{PurchPrice}{$key},
  1039. $Dat{PurchDate}{$key} );
  1040. foreach ('Symbol', 'Name', 'Nb of Shares', 'Cross-currency',
  1041. 'Purchase Price', 'Purchase Date') {
  1042. my $E = $FR->Entry(-textvariable => \$data[$row],
  1043. -relief => 'sunken', -width => 20);
  1044. my $L = $FR->Label(-text => $ARG, -anchor => 'e', -justify => 'right');
  1045. Tk::grid($L, -row => $row, -column => 0, -sticky => 'e');
  1046. Tk::grid($E, -row => $row++, -column => 1, -sticky => 'ew');
  1047. $FR->gridRowconfigure(1, -weight => 1);
  1048. $E->focus if $ARG eq 'Symbol (required)';
  1049. }
  1050. $TL->Button(-text => 'Ok', -command => sub { # 0 is the symbol, not stored
  1051. $Dat{GivenName}{$key} = defined($data[1]) ? $data[1] : "";
  1052. $Dat{Shares}{$key} = defined($data[2]) ? $data[2] : 0;
  1053. $Dat{Cross}{$key} = defined($data[3]) ? $data[3] : "";
  1054. $Dat{PurchPrice}{$key} = defined($data[4]) ? $data[4] : 0;
  1055. $Dat{PurchDate}{$key} = defined($data[5]) ? $data[5] : 0;
  1056. $TL->destroy();
  1057. init_fx();
  1058. }
  1059. )->pack(-side => 'bottom');
  1060. }
  1061. sub init_fx { # find unique crosscurrencies
  1062. undef $Dat{FXarr};
  1063. my %hash; # to compute a unique subset of the FX crosses
  1064. foreach my $key (keys %{$Dat{Cross}}) {
  1065. my $val = $Dat{Cross}{uc $key}; # the actual cross-currency
  1066. if ($val ne "" and not $hash{$val}) {
  1067. push @{$Dat{FXarr}}, $val."=X"; # store this as Yahoo's symbol
  1068. $hash{$val} = 1; # store that's we processed it
  1069. }
  1070. }
  1071. }
  1072. sub show_gallery { # update the pictures in 'gallery' mode
  1073. view_image($Main, $ARG) foreach (0..$#{$Dat{Arg}});
  1074. }
  1075. sub init_data { # fill all arguments into main data structure
  1076. my @args = @_;
  1077. if (defined($main::options{proxy})) {
  1078. $Finance::YahooQuote::PROXY = $options{proxy};
  1079. }
  1080. if (defined($options{firewall}) and
  1081. $options{firewall} ne "" and
  1082. $options{firewall} =~ m/.*:.*/) {
  1083. my @q = split(':', $main::options{firewall}, 2);
  1084. $Finance::YahooQuote::PROXYUSER = $q[0];
  1085. $Finance::YahooQuote::PROXYPASSWD = $q[1];
  1086. }
  1087. menus(); # create frame, and populate with menus
  1088. if (defined $args[0]) { # if we had arguments
  1089. undef $Dat{Arg}; # unset previous ones
  1090. foreach $ARG (@args) { # and fill
  1091. insert_stock($ARG); # new ones
  1092. }
  1093. }
  1094. init_fx();
  1095. buttons();
  1096. }
  1097. sub file_save { # store in resource file
  1098. my $file = $options{file};
  1099. open (FILE, ">$file") or die "Cannot open $file: $!\n";
  1100. print FILE "\#\n\# smtm version $VERSION resource file saved on ",
  1101. strftime("%c", localtime);
  1102. print FILE "\n\#\n";
  1103. foreach my $key (keys %options) {
  1104. print FILE "$key=", eval("\$options{$key}"),"\n"
  1105. if eval("defined(\$options{$key})");
  1106. }
  1107. foreach my $key (keys %chart) {
  1108. # hash args get unrolled into a string joined by ':'
  1109. if (ref($chart{$key}) and ref($chart{$key}) eq "HASH") {
  1110. print FILE "chart::$key=";
  1111. foreach my $chart (keys %{$chart{$key}}) {
  1112. print FILE "$chart:" if $chart{$key}{$chart};
  1113. }
  1114. print FILE "\n";
  1115. } else {
  1116. print FILE "chart::$key=", eval("\$chart{$key}"),"\n"
  1117. if eval("defined(\$chart{$key})");
  1118. }
  1119. }
  1120. foreach (0..$#{$Dat{Arg}}) {
  1121. my $key = @{$Dat{Arg}}[$ARG];
  1122. print FILE join(':', ($Dat{Symbol}{$key}, $Dat{GivenName}{$key},
  1123. $Dat{Shares}{$key}, $Dat{Cross}{$key},
  1124. $Dat{PurchPrice}{$key},
  1125. $Dat{PurchDate}{$key})), "\n";
  1126. }
  1127. close(FILE);
  1128. }
  1129. sub add_stock {
  1130. my $TL = $Main->Toplevel; # new toplevel widget ...
  1131. $TL->title ("Add Stock");
  1132. $TL->resizable(0,0); # no resizing
  1133. my $FR = $TL->Frame->pack(-fill => 'both');
  1134. my $row = 0;
  1135. my @data = ("", "", "", "", "", "" );
  1136. foreach ('Symbol', 'Name', 'Nb of Shares', 'Cross-currency',
  1137. 'Purchase Price', 'Purchase Date') {
  1138. my $E = $FR->Entry(-textvariable => \$data[$row],
  1139. -relief => 'sunken', -width => 20);
  1140. my $L = $FR->Label(-text => $ARG, -anchor => 'e', -justify => 'right');
  1141. Tk::grid($L, -row => $row, -column => 0, -sticky => 'e');
  1142. Tk::grid($E, -row => $row++, -column => 1, -sticky => 'ew');
  1143. $FR->gridRowconfigure(1, -weight => 1);
  1144. $E->focus if $ARG eq 'Symbol (required)';
  1145. }
  1146. $TL->Button(-text => 'Ok',
  1147. -command => sub {
  1148. $ARG = join(':', @data);
  1149. $TL->destroy();
  1150. insert_stock($ARG);
  1151. init_fx();
  1152. buttons();
  1153. }
  1154. )->pack(-side => 'bottom');
  1155. }
  1156. sub del_stock { # delete one or several stocks
  1157. my $TL = $Main->Toplevel; # new toplevel widget ...
  1158. $TL->resizable(0,0); # no resizing
  1159. $TL->title ("Delete Stock(s)");
  1160. my $LB = $TL->Scrolled("Listbox",
  1161. -selectmode => "multiple",
  1162. -scrollbars => "e",
  1163. -font => $BFont,
  1164. -width => 16
  1165. )->pack();
  1166. my (@data); # array of symbols in displayed order
  1167. my $prefsort = $options{sort};
  1168. $options{sort} = 'n';
  1169. foreach (sort sort_func values %{$Dat{Data}}) {
  1170. my @arr = split (';', $ARG);
  1171. $LB->insert('end', $arr[1]);
  1172. push @data, $arr[0];
  1173. }
  1174. $options{sort} = $prefsort;
  1175. $TL->Label(-text => 'Select stocks to be deleted')->pack();
  1176. $TL->Button(-text => 'Delete',
  1177. -command => sub {
  1178. my @A; # temp. array
  1179. foreach (0..$#data) {
  1180. push @A, $data[$ARG]
  1181. unless $LB->selectionIncludes($ARG);
  1182. }
  1183. @{$Dat{Arg}} = @A;
  1184. $TL->destroy();
  1185. buttons();
  1186. }
  1187. )->pack(-side => 'bottom');
  1188. }
  1189. sub chg_delay { # window to modify delay for update
  1190. my $TL = $Main->Toplevel; # new toplevel widget ...
  1191. $TL->resizable(0,0); # no resizing
  1192. $TL->title ("Modify Delay");
  1193. my $SC = $TL->Scale(-from => 1,
  1194. -to => 60,
  1195. -orient => 'horizontal',
  1196. -sliderlength => 15,
  1197. -variable => \$options{delay})->pack();
  1198. $TL->Label(-text => 'Select update delay in minutes')->pack();
  1199. $TL->Button(-text => 'Ok',
  1200. -command => sub { $TL->destroy();
  1201. buttons();
  1202. } )->pack(-side => 'bottom');
  1203. }
  1204. sub get_comparison_symbol { # window to modify delay for update
  1205. my $TL = $Main->Toplevel; # new toplevel widget ...
  1206. $TL->resizable(0,0); # no resizing
  1207. $TL->title ("Enter Comparison Symbol");
  1208. my $FR = $TL->Frame->pack(-fill => 'both');
  1209. my $data = $chart{comparison};
  1210. my $label = 'Comparison Symbol';
  1211. my $E = $FR->Entry(-textvariable => \$data,
  1212. -relief => 'sunken',
  1213. -width => 20);
  1214. my $L = $FR->Label(-text => 'Comparison Symbol',
  1215. -anchor => 'e',
  1216. -justify => 'right');
  1217. Tk::grid($L, -row => 0, -column => 0, -sticky => 'e');
  1218. Tk::grid($E, -row => 0, -column => 1, -sticky => 'ew');
  1219. $FR->gridRowconfigure(1, -weight => 1);
  1220. $E->focus;
  1221. $TL->Button(-text => 'Ok',
  1222. -command => sub { $chart{comparison} = "$data";
  1223. $TL->destroy();
  1224. }
  1225. )->pack(-side => 'bottom');
  1226. }
  1227. sub help_about { # show a help window
  1228. my $TL = $Main->Toplevel; # uses pod2text on this very file :->
  1229. $TL->resizable(0,0); # no resizing
  1230. $TL->title("Help about smtm");
  1231. my $Text = $TL->Scrolled("Text",
  1232. -width => 80,
  1233. -scrollbars => 'e')->pack();
  1234. button_or_mouseclick_close($TL,$Text);
  1235. open (FILE, "pod2text \"$PROGRAM_NAME\" | ");
  1236. while (<FILE>) {
  1237. $Text->insert('end', $ARG); # insert what pod2text show when applied
  1238. } # to this file, the pod stuff is below
  1239. close(FILE);
  1240. }
  1241. sub help_license { # show a license window
  1242. my $TL = $Main->Toplevel; # uses pod2text on this very file :->
  1243. $TL->resizable(0,0); # no resizing
  1244. $TL->title("Copying smtm");
  1245. my $Text = $TL->Text(-width => 77,
  1246. -height => 21)->pack();
  1247. button_or_mouseclick_close($TL,$Text);
  1248. open (FILE, "< $PROGRAM_NAME");
  1249. while (<FILE>) { # show header
  1250. last if m/^$/;
  1251. next unless (m/^\#/ and not m/^\#\!/);
  1252. $ARG =~ s/^\#//; # minus the leading '#'
  1253. $Text->insert('end', $ARG);
  1254. }
  1255. $Text->insert('end', "\n smtm version $VERSION as of $date");
  1256. close(FILE);
  1257. }
  1258. sub get_firewall_id {
  1259. my ($user,$passwd);
  1260. my $TL = $Main->Toplevel; # new toplevel widget ...
  1261. $TL->resizable(0,0); # no resizing
  1262. $TL->title ("Specify Firewall ID");
  1263. my $FR = $TL->Frame->pack(-fill => 'both');
  1264. my $row = 0;
  1265. my @data = ( "", "" );
  1266. foreach ('Firewall Account', 'Firewall Password') {
  1267. my $E = $FR->Entry(-textvariable => \$data[$row],
  1268. -relief => 'sunken',
  1269. -width => 20) if $row eq 0;
  1270. $E = $FR->Entry(-textvariable => \$data[$row],
  1271. -relief => 'sunken',
  1272. -show => '*',
  1273. -width => 20) if $row eq 1;
  1274. my $L = $FR->Label(-text => $ARG,
  1275. -anchor => 'e',
  1276. -justify => 'right');
  1277. Tk::grid($L, -row => $row, -column => 0, -sticky => 'e');
  1278. Tk::grid($E, -row => $row, -column => 1, -sticky => 'ew');
  1279. $FR->gridRowconfigure(1, -weight => 1);
  1280. $E->focus if $row++ eq 0;
  1281. }
  1282. $TL->Button(-text => 'Ok',
  1283. -command => sub { $options{firewall} = "$data[0]:$data[1]";
  1284. $TL->destroy();
  1285. update_display_variables();
  1286. }
  1287. )->pack(-side => 'bottom');
  1288. }
  1289. sub help_exit { # command-line help
  1290. print STDERR "
  1291. smtm -- Display/update a global stock ticker, profit/loss counter and charts
  1292. smtm version $VERSION of $date
  1293. Copyright (C) 1999 - 2008 by Dirk Eddelbuettel <edd\@debian.org>
  1294. smtm comes with ABSOLUTELY NO WARRANTY. This is free software,
  1295. and you are welcome to redistribute it under certain conditions.
  1296. For details, select Help->License or type Alt-h l once smtm runs.
  1297. Usage:
  1298. smtm [options] [symbol1 symbol2 symbol3 ....]
  1299. Options:
  1300. --time minutes minutes to wait before update of display
  1301. (default value: $options{delay})
  1302. --file rcfile file to store and/or retrieve selected shares
  1303. (default value: $options{file})
  1304. --proxy proxyadr network address and port of firewall proxy
  1305. (default value: none, i.e. no proxy)
  1306. --fwall [id:pw] account and password for firewall, if the --fwall option
  1307. is used but not firewall id or passwd are give, a window
  1308. will prompt for them
  1309. (default value: none, i.e. no firewall)
  1310. --columns set select the displayed columns by adding the respective
  1311. letter to the variable set; choose from 's' for
  1312. stock symbol, 'n' for the name, 'l' for last
  1313. price. 'a' for absolute price change, 'r' for
  1314. relative price change, 'V' for the volume traded,
  1315. 'p' for the profit or loss in the position, 'v'
  1316. for the value of the position, 'h' for the length
  1317. of the holding period, 'R' or the annualised return
  1318. 'd' for the drawdown from the 52-week high,
  1319. 'e' for earnings per share, 'P' for the price/earnings
  1320. ratio, 'D' for the dividend yield, 'm' for market
  1321. capitalization and lastly, 'f' for the 'file position'
  1322. (i.e. the position in which the stock were specified)
  1323. --chart len select length of data interval shown in chart, choose
  1324. one of 'b' (intra-day), 'w' (1 week), '3' (3 months),
  1325. '6' (6 months), '1' (1 year), '2' (2 year), '5'
  1326. (5 year) or 'm' (max years) (default: $chart{length})
  1327. 't' selects a five-day thumbnail, this is not available
  1328. for all symbols.
  1329. --gallery show and update charts of all available symbols
  1330. --timeout len timeout value in seconds for libwww-perl UserAgent
  1331. (default value: $options{timeout})
  1332. --wide display the holdings value and change in the window title
  1333. --percent show relative performance in percent instead of bps
  1334. --sort style sort display of shares by specified style, choose
  1335. 'r' for relative change, 'a' for absolute change
  1336. 'p' for position change, 'v' for position value,
  1337. 'V' for trading volume, 'h' for holding period,
  1338. 'R' for annual return, 'd' for drawdown, 'e' for
  1339. earnings, 'P' for price/earnings, 'D' for
  1340. dividend yield, 'm' for market capitalization,
  1341. 'f' for the 'file position' and 'n' for name.
  1342. (default value: $options{sort})
  1343. --nookbutton close other windows via left mouseclick, suppress button
  1344. --verbose more output on stdout (not used much currently)
  1345. --help print this help and version message
  1346. Examples:
  1347. smtm T::10:USDCAD BCE.TO::10
  1348. smtm --time 15 \"T:Ma Bell:200:USDCAD:62:19960520\"
  1349. smtm --file ~/.smtm/telcos.smtm --columns nlarV
  1350. smtm --proxy http://192.168.100.100:80 --fwall foobar:secret
  1351. \n";
  1352. exit 0;
  1353. }
  1354. __END__ # that's it, folks! Documentation below
  1355. #---- Documentation ---------------------------------------------------------
  1356. =head1 NAME
  1357. smtm - Display and update a configurable ticker of global stock quotes
  1358. =head1 SYNOPSYS
  1359. smtm [options] [stock_symbol ...]
  1360. =head1 OPTIONS
  1361. --time min minutes to wait before update
  1362. --file smtmrc to store/retrieve stocks selected
  1363. --proxy pr network address and port of firewall proxy
  1364. --fwall [id:pw] account and password for firewall
  1365. --chart len select length of data interval shown in chart
  1366. (must be one of b, w, 3, 6, 1, 2, 5, m or t)
  1367. --timeout len timeout in seconds for libwww-perl UserAgent
  1368. --wide also display value changes and holdings
  1369. --percent show relative performance in percent instead of bps
  1370. --sort style sort display by specified style
  1371. (must be one r, a, p, v, n, v, V or h)
  1372. --columns set choose the columns to display (can be any combination
  1373. of s, n, l, a, r, v, p, V, R, h)
  1374. --nookbutton close other windows via left mouseclick, suppress button
  1375. --help print a short help message
  1376. =head1 DESCRIPTION
  1377. B<smtm>, which is a not overly clever acronym for B<Show Me The
  1378. Money>, is a financial ticker and portfolio application for quotes
  1379. from exchanges around the world (provided they are carried on
  1380. Yahoo!). It creates and automatically updates a window with quotes
  1381. from Yahoo! Finance. It can also display the entire variety of charts
  1382. available at Yahoo! Finance. When called with one or several symbols,
  1383. it displays these selected stocks. When B<smtm> is called without
  1384. arguments, it reads the symbols tickers from a file, by default
  1385. F<~/.smtmrc>. This file can be created explicitly by calling the Save
  1386. option from the File menu. Beyond stocks, B<smtm> can also display
  1387. currencies (from the Philadephia exchange), US mutual funds, options
  1388. on US stocks, several precious metals and quite possibly more; see the
  1389. Yahoo! Finance website for full information.
  1390. B<smtm> can also aggregate the change in value for both individual
  1391. positions and the the entire portfolio. For this, the number of
  1392. shares is needed, as well as the cross-currency expression pair. The
  1393. standard ISO notation is used. As an example, GBPUSD translates from
  1394. Pounds into US Dollars. To compute annualised returns, the purchase
  1395. date and purchase price can also be entered.
  1396. B<smtm> displays the full name of the company, the absolute price
  1397. change and the relative percentage change in basispoints (i.e.,
  1398. hundreds of a percent) or in percentages if the corresponding option
  1399. has been selected. Other information that can be displayed are the
  1400. traded volume, the profit/loss, the aggregate positon value, the
  1401. holding period length, the annualised return, the drawdown, the
  1402. earnings per share, the price/earnings ratio, the dividend yield, and
  1403. the market capitalization. Note that the return calculation ignores
  1404. such fine points as dividends, and foreign exchange appreciation or
  1405. depreciation for foreigns stocks. All display columns can be
  1406. selected, or deselected, individually.
  1407. Losers are flagged in red. B<smtm> can be used for stocks from the
  1408. USA, Canada, various European exchanges, various Asian exchanges
  1409. (Singapore, Taiwan, HongKong, Kuala Lumpur, ...) Australia and New
  1410. Zealand. It should work for other markets supported by Yahoo. US
  1411. mutual funds are also available, but less relevant as their net asset
  1412. value is only computed after the market close. Some fields might be
  1413. empty if Yahoo! does not supply the full set of fields; the number of
  1414. supported fields varies even among US exchanges. The sorting order can
  1415. be chosen among eight different options.
  1416. The quotes and charts are delayed, typically 15 minutes for NASDAQ and
  1417. 20 minutes otherwise, see F<http://finance.yahoo.com> for details. New
  1418. Zealand is rumoured to be somewhat slower with a delay of one
  1419. hour. However, it is worth pointing out that (at least some) US)
  1420. indices are updated in real time at Yahoo!, and therefore available in
  1421. real time to B<smtm>. Intra-day and five-day charts are updated
  1422. during market hours by Yahoo!, other charts with longer timeframes are
  1423. updated only once a week by Yahoo!.
  1424. B<smtm> supports both simple proxy firewalls (via the I<--proxy> option)
  1425. and full-blown firewalls with account and password authorization (via the
  1426. I<--fwall> option). Firewall account name and password can be specified as
  1427. command line arguments after I<--fwall>, or else in a pop-up window. This
  1428. setup has been in a few different environments.
  1429. B<smtm> can display two more views of a share position. Clicking mouse
  1430. button 1 launches a detailed view with price, date, change, volume,
  1431. bid, ask, high, low, year range, price/earnings, dividend, dividend
  1432. yield, market capital information, number of shares held and
  1433. annualised return. However, not all of that information is available
  1434. at all exchanges. Clicking the right mouse button display a chart of
  1435. the corresponding stock; this only works for US and Canadian stocks.
  1436. The type of chart can be specified either on the command-line, or via
  1437. the Chart menu. Choices are intraday, five day, three months, six
  1438. months, one year, two years, five years or max years. The default chart
  1439. is a five day chart. The middle mouse button opens an edit window to
  1440. modify and augment the information stored per stock.
  1441. See F<http://help.yahoo.com/help/us/fin/chart/> for help on Yahoo!
  1442. Finance charts.
  1443. B<smtm> has been written and tested under Linux. It should run under
  1444. any standard Unix, success with Solaris, HP-UX and FreeBSD is
  1445. confirmed (but problems are reported under Solaris when a threaded
  1446. version of Perl is used). It also runs under that other OS from
  1447. Seattle using the B<ActivePerl> implementation from
  1448. F<http://www.activestate.com>. In either case, it requires the
  1449. F<Perl/Tk> module for windowing, and the F<LWP> module (also known as
  1450. F<libwww-perl>) for data retrieval over the web. The excellent
  1451. F<Date::Manip> modules is also required for the date parsing and
  1452. calculations. With recent versions of ActivePerl, only Date::Manip
  1453. needs to be installed on top of the already provided modules.
  1454. =head1 EXAMPLES
  1455. smtm CSCO NT
  1456. creates a window following the Cisco and Nortel stocks.
  1457. smtm MSFT:Bill SUNW:Scott ORCL:Larry
  1458. follows three other tech companies and uses the override feature for
  1459. the displayed name. [ Historical note: We once needed that for
  1460. European stocks as Yahoo! did not supply the company name way back in
  1461. 1999 or so. This example just documents a now ancient feature. ]
  1462. smtm BT.A.L::10:GBPCAD T::10:USDCAD \
  1463. BCE.TO::10 13330.PA::10:EURCAD \
  1464. "555750.F:DT TELECOM:10:EURCAD"
  1465. creates a window with prices for a handful of telecom companies on
  1466. stock exchanges in London, New York, Toronto, Paris and
  1467. Frankfurt. Note how a names is specified to override the verbose
  1468. default for the German telco. Also determined are the number of
  1469. shares, here 10 for each of the companies. Lastly, this example
  1470. assumes a Canadian perspective: returns are converted from British
  1471. pounds, US dollars and Euros into Canadian dollars. Quotation marks
  1472. have to be used to prevent the shell from splitting the argument
  1473. containing spaces. [ Historical note: The Deutsche Telecom stock can
  1474. now also be referenced as DTEGn.DE; similarly other stock previously
  1475. available only under their share number are now accessible using an
  1476. acronym reflecting their company name.]
  1477. =head1 MENUS
  1478. Four menus are supported: I<File>, I<Edit>, I<Chart> and I<Help>. The
  1479. I<File> menu offers to load or save to the default file, or to 'save
  1480. as' a new file. I<Exit> is also available.
  1481. The I<Edit> menu can launch windows to either add a new stock or
  1482. delete one or several from a list box. Submenus for column selection
  1483. based on various criteria are available. Similarly, the I<Sort> menu
  1484. allows to select one of eight different sort options. Further, one
  1485. can modify the delay time between updates and choose between the
  1486. default title display or the wide display with changes in the position
  1487. and total position value.
  1488. The I<Charts> menu allows to select the default chart among the eight
  1489. choices intraday, five day, three months, six months, one year, two
  1490. years, five years or 'max' years. Chart sizes can be selected among
  1491. three choices. Plot types can be selected among line chart, bar chart
  1492. and the so-called candlestick display. For both moving averages and
  1493. exponential moving averages, six choices are avilable (5, 10, 20, 50,
  1494. 100 and 200 days, respectively) which can all be selected (or
  1495. deselected) individually. Similarly, any one of seven popular
  1496. technical analysis charts can be added. Logarithmic scale can be
  1497. turned on/off. Volume bar charts as also be selected or
  1498. deselected. Similarly, Bollinger bands and the parabolic SAR can be
  1499. selected. A selection box can be loaded to enter another symbol (or
  1500. several of these, separated by comma) for performance
  1501. comparison. Lastly, the gallery command can launch the display of a
  1502. chart for each and every stock symbol currenly loaded in the smtm
  1503. display. Note that intra-day and intra-week charts do not offer all
  1504. the various charting options longer-dated charts have available. Once
  1505. charts are shown, they are also updated regularly at the same interval
  1506. the main displayed is updated at.
  1507. Lastly, the I<Help> menu can display either the text from the manual
  1508. page, or the copyright information in a new window.
  1509. =head1 DISPLAY
  1510. The main window is very straightforward. For each of the stocks, up to
  1511. eleven items can be displayed: its symbol, its name, its most recent
  1512. price, the change from the previous close in absolute terms, the
  1513. change in relative terms, the volume, the profit or loss, the total
  1514. position value, the holding period, the annualised return (bar F/X
  1515. effects or dividends) and the drawdown relative to the 52-week high.
  1516. The relative change is either expressed in basispoints (bps), which
  1517. are 1/100s of a percent, or in percent; this can be controlled via a
  1518. checkbutton as well as an command-line option. Further display
  1519. options are earnings per share, price/earnings ratio, dividend yield
  1520. and market capitalization. This display window is updated in regular
  1521. intervals; the update interval can be specified via a menu or a
  1522. command-line option.
  1523. The window title displays the relative portfolio profit or loss for
  1524. the current day in basispoints, i.e., hundreds of a percent, or in
  1525. percent if the corresponding option is chosen, as well as the date of
  1526. the most recent update. If the I<--wide> options is used, the net
  1527. change and ney value of the portfolio (both in local currency) are
  1528. also displayed.
  1529. Clicking on any of the stocks with the left mouse button opens a new
  1530. window with all available details for a stock. Unfortunately, the
  1531. amount of available information varies. Non-North American stocks only
  1532. have a limited subset of information made available via the csv
  1533. interface of Yahoo!. For North American stocks, not all fields all
  1534. provided by all exchanges. Clicking on the details display window
  1535. itself closes this window. Clicking on any of the stocks with the
  1536. right mouse button opens a new window with a chart of the given stock
  1537. in the default chart format. This option was initially available only
  1538. for North American stocks but now works across most if not all
  1539. markets, thanks to expanded support by Yahoo!. Clicking on the chart
  1540. window itself closes this window. Finally, the middle mouse button
  1541. opens an edit window.
  1542. =head1 CHART DISPLAY (AKA 'GALLERY' MODE)
  1543. In 'gallery' mode, chart windows are opened for all active securities.
  1544. These charts are automatically updated whenever the display is
  1545. updated. This mean that only the intra-daily and intra-weekly chart
  1546. timeframe selection are meaningful -- all others are updated at the
  1547. source, i.e. Yahoo!, daily or weekly, and there is no little point in
  1548. downloading the same chart over and over again.
  1549. However, for intra-daily and intra-weekly charts, this is a very
  1550. useful feature. It should be noted that not all chart size, chart
  1551. timeframe and chart option permutations actually lead to existing
  1552. charts. For example, logarithmic scale does seem to exist for
  1553. shorter-dated time frames. Neither does the 'small' chart size.
  1554. =head1 BUGS
  1555. Closing the stock addition or deletion windows have been reported to
  1556. cause random segmentation violation under Linux. This appears to be a
  1557. bug in Perl/Tk which will hopefully be solved, or circumvented, soon.
  1558. This bug does not bite under Solaris, FreeBSD or NT or other Linux
  1559. distributions. Update: This problem appears to have disappeared with
  1560. Perl 5.6.*.
  1561. Problems with undefined symbols have been reported under Solaris 2.6
  1562. when Perl has been compiled with thread support. Using an unthreaded
  1563. Perl binary under Solaris works. How this problem can be circumvented
  1564. is presently unclear.
  1565. It is not clear whether the market capitalization information is
  1566. comparable across exchange. Some differences could be attributable to
  1567. 'total float' versus 'free float' calculations.
  1568. =head1 SEE ALSO
  1569. F<Finance::YahooQuote.3pm>, F<Finance::YahooChart.3pm>, F<LWP.3pm>,
  1570. F<lwpcook.1>, F<Tk::UserGuide.3pm>
  1571. See F<http://help.yahoo.com/help/us/fin/chart/> for help on Yahoo!
  1572. Finance charts.
  1573. =head1 COPYRIGHT
  1574. smtm is (c) 1999 - 2008 by Dirk Eddelbuettel <edd@debian.org>
  1575. Updates to this program might appear at
  1576. F<http://dirk.eddelbuettel.com/code/smtm.html>. If you enjoy this
  1577. program, you might also want to look at my beancounter program
  1578. F<http://dirk.eddelbuettel.com/code/beancounter.html>, as well as the
  1579. Finance::YahooQuote module at
  1580. F<http://dirk.eddelbuettel.com/code/yahooquote.html> which was
  1581. originally written by Dj Padzensky, and that is used by both B<smtm>
  1582. and B<beancounter>.
  1583. This program is free software; you can redistribute it and/or modify
  1584. it under the terms of the GNU General Public License as published by
  1585. the Free Software Foundation; either version 2 of the License, or
  1586. (at your option) any later version. There is NO warranty whatsoever.
  1587. The information that you obtain with this program may be copyrighted
  1588. by Yahoo! Inc., and is governed by their usage license. See
  1589. F<http://www.yahoo.com/docs/info/gen_disclaimer.html> for more
  1590. information.
  1591. =head1 ACKNOWLEDGEMENTS
  1592. The Perl code by Dj Padzensky, in particular his
  1593. B<Finance::YahooQuote> module (originally on the web at
  1594. F<http://www.padz.net/~djpadz/YahooQuote/> and now maintained by me at
  1595. F<http://dirk.eddelbuettel.com/code/yahooquote.html/>) and his
  1596. Finance::YahooChart module (on the web at
  1597. F<http://www.padz.net/~djpadz/YahooChart/>) were most helpful. They
  1598. provided the initial routines for downloading stock data and
  1599. determining the Yahoo! Chart url. Earlier version of B<smtm> use a
  1600. somewhat rewrittem variant (which still reflected their heritage),
  1601. newer version rely directly on B<Finance::YahooQuote> now that Yahoo!
  1602. uses a similar backend across the globe. Dj's code contribution is
  1603. most gratefully acknowledged.
  1604. =head1 CPAN
  1605. The remaining sections pertain to the CPAN registration of
  1606. B<smtm>. The script category is a little mismatched but as there is no
  1607. Finance section, F<Networking> was as good as the other choices.
  1608. =head1 SCRIPT CATEGORIES
  1609. Networking
  1610. =head1 PREREQUISITES
  1611. On Windows, F<smtm> can use the Perl distribution from
  1612. F<http://www.activestate.com>. On both Unix and Windows, B<smtm>
  1613. requires the C<Tk> module for windowing, the C<LWP> module for data
  1614. retrieval over the web, and the excellent C<Date::Manip> module for
  1615. the date parsing and calculations. Finance::YahooQuote is used for
  1616. actual data access. Tk::PNG is used to display the png charts since
  1617. Yahoo! switched from gif to png around May 2005.
  1618. =head1 COREQUISITES
  1619. None.
  1620. =head1 OSNAMES
  1621. F<smtm> is not OS dependent. It is known to run under Linux, several
  1622. commercial Unix variants and Windows
  1623. =head1 README
  1624. B<smtm>, which is a not overly clever acronym for B<Show Me The
  1625. Money>, is a financial ticker and portfolio application for quotes
  1626. from exchanges around the world (provided they are carried on
  1627. Yahoo!). It creates and automatically updates a window with quotes
  1628. from Yahoo! Finance. It can also display the entire variety of charts
  1629. available at Yahoo! Finance. Fairly extensive documentation for
  1630. B<smtm> is available at F<http://dirk.eddelbuettel.com/code/smtm.html>.
  1631. =cut