/smtm
Perl | 1810 lines | 1588 code | 164 blank | 58 comment | 276 complexity | ea39aa08458a9ccb88c44c12cd8aec74 MD5 | raw file
Possible License(s): GPL-2.0
Large files files are truncated, but you can click here to view the full file
- #!/usr/bin/perl -w
- #
- # smtm --- A global stock ticker for X11 and Windoze
- #
- # Copyright (C) 1999 - 2008 Dirk Eddelbuettel <edd@debian.org>
- #
- # This program is free software; you can redistribute it and/or modify
- # it under the terms of the GNU General Public License as published by
- # the Free Software Foundation; either version 2 of the License, or
- # (at your option) any later version.
- #
- # This program is distributed in the hope that it will be useful,
- # but WITHOUT ANY WARRANTY; without even the implied warranty of
- # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- # GNU General Public License for more details.
- #
- # You should have received a copy of the GNU General Public License
- # along with this program; if not, write to the Free Software
- # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- # $Id: smtm.pl,v 1.122 2008/05/25 22:44:35 edd Exp $
- use strict; # be careful out there, my friend
- use English; # explicit variable names
- #use Data::Dumper; # FIXME
- use Date::Manip; # for date calculations
- use File::Spec; # portable filename operations
- use Finance::YahooQuote; # fetch quotes from Yahoo!
- use Getopt::Long; # parse command-line arguments
- use HTTP::Request::Common; # still needed to get charts
- use IO::File; # needed for new_tmpfile or Tk complains
- use POSIX qw(strftime); # strftime function
- use MIME::Base64; # to encode graphics directly for Photo widget
- use Text::ParseWords; # parse .csv files more reliably
- use Tk; # who needs gates in a world full o'windows?
- use Tk::Balloon; # widget for context-sensitive help
- use Tk::FileSelect; # widget for selecting files
- use Tk::PNG; # as of May 2005, Yahoo! send png charts
- use vars qw{%options %chart}; # need to define here for SUB {} below
- my # seperate for Makefile.PL
- $VERSION = "1.6.10"; # updated from the debian/rules Makefile
- my $date = # inner expression updated by RCS
- sprintf("%s", q$Date: 2008/05/25 22:44:35 $ =~ /\w*: (\d*\/\d*\/\d*)/);
- my (@Labels, # labels which carry the stock info
- @Buttons, # buttons which contain the labels,
- $BFrame, # frame containing the buttons
- $BFont, # font used for display on buttons + details
- $Header, # frame for column headings
- $headertext, # string for column headings display
- %coldisp, # hash of selected columns
- %Dat); # hash of hashes and lists for global data
- my $Main = new MainWindow; # create main window
- if ($OSNAME =~ m/MSWin32/) { # branch out for OS
- $Main->setPalette("gray95"); # light gray background
- $BFont = $Main->fontCreate(-family => 'courier', -size => 8);
- $ENV{HOME} = "C:/TEMP" unless $ENV{HOME};
- $ENV{TZ} = "GMT" unless $ENV{TZ}; # Date::Time needs timezone info
- } else {
- # $BFont = $Main->fontCreate(-family => 'lucidasanstypewriter', -size => 10);
- $BFont = $Main->fontCreate(-family => 'fixed', -size => 10);
- # $BFont = $Main->fontCreate(-family => 'courier', -size => 10);
- }
- # general options for user interface and behaviour, sort-of ugly global
- $options{file} = File::Spec->catfile($ENV{HOME}, ".smtmrc"); #default rc file
- $options{sort} = 'n'; # sort by name
- $options{timeout} = 180; # default timeout used in LWP code
- $options{columns} = 'nrla'; # default colums: name,last, rel.chg, abs. chg
- $options{percent} = 0; # default to percentage display, not bps
- $options{paused} = 0; # default to not paused, i.e. update
- $options{delay} = 5; # wait this many minutes
- ($options{firewall}, $options{proxy}, $options{wide}) = (undef,undef,undef);
- # global hash for chart options
- $chart{length} = '1'; # one-year chart is default chart
- $chart{log_scale} = 1; # plot on logarithmic scale
- $chart{volume} = 1; # show volume on seperate pane
- $chart{size} = 'm'; # plot size, default small (m medium, l large)
- $chart{style} = 'l'; # plot type, line ('c' candle, 'b' for bar)
- $chart{ma} = (); # placeholder hash for mov.avg. options
- $chart{ema} = (); # placeholder hash for exp.mov.avg. options
- $chart{technical} = (); # placeholder hash for tech. analysis options
- $chart{bollinger} = 0; # show bollinger bands
- $chart{parabolic_sar} = 0; # show parabolic sar
- $chart{comparison} = ""; # compare to this symbol (eg stock)
- my $today = ParseDate("today"); # current time, date for return calculations
- my $symbolcounter = 0; # needed for several pos. in same stock
- my %commandline_options = ("file=s" => \$options{file},
- "time=i" => \$options{delay},
- "fwall:s" => \$options{firewall},
- "proxy=s" => \$options{proxy},
- "wide" => \$options{wide},
- "percent" => \$options{percent},
- "columns=s" => \$options{columns},
- "sort=s" => \$options{sort},
- "nookbutton"=> \$options{nookbutton},
- "timeout=i" => \$options{timeout},
- "chart=s" => \$chart{length},
- "gallery" => \$options{gallery},
- "verbose" => \$options{verbose},
- "help" => \$options{help});
- # exit with helpful message if unknown command-line option, or help request
- help_exit() if (!GetOptions(%commandline_options) or $options{help});
- if ($#ARGV==-1) { # if no argument given
- if (-f $options{file}) { # if file exists
- read_config(); # load from file
- init_data(undef); # this indirectly calls buttons()
- } else { # else use default penguin portfolio
- warn("No arguments given, and no file found. Using example portfolio.\n");
- init_data(("RY.TO::50::48:20000104",
- "C::50:USDCAD:50.50:20000103",
- "DBK.DE::50:EURCAD:86.5:20010102",
- "HSBA.L::50:GBPCAD:967.02:20010101"))
- }
- } else { # else
- init_data(@ARGV); # use the given arguments
- }
- MainLoop; # and launch event loop under X11
- #----- Functions ------------------------------------------------------------
- sub menus { # create the menus
- # copy selected colums from string into hash
- for my $i (0..length($options{columns})-1) {
- $coldisp{substr($options{columns}, $i, 1)} = 1;
- }
- $Main->optionAdd("*tearOff", "false");
- my $MF = $Main->Frame()->pack(-side => 'top',
- -anchor => 'n',
- -expand => 1,
- -fill => 'x');
- my @M;
- $M[0] = $MF->Menubutton(-text => 'File', -underline => 0,
- )->pack(-side => 'left');
- $M[0]->AddItems(["command"=> "~Open", -command => \&select_file_and_open],
- ["command"=> "~Save", -command => \&file_save],
- ["command"=> "Save ~As",-command => \&select_file_and_save],
- ["command"=> "E~xit", -command => sub { exit }]);
- $M[1] = $MF->Menubutton(-text => 'Edit', -underline => 0,
- )->pack(-side => 'left');
- $M[1]->AddItems(["command" => "~Add Stock", -command => \&add_stock]);
- $M[1]->AddItems(["command" => "~Delete Stock(s)", -command => \&del_stock]);
- my $CasX = $M[1]->cascade(-label => '~Columns');
- my %colbutton_text = ('s' => '~Symbol',
- 'n' => '~Name',
- 'l' => '~Last Price',
- 'a' => '~Absolute Change',
- 'r' => '~Relative Change',
- 'V' => '~Volume traded',
- 'p' => 'Position ~Change',
- 'v' => '~Position Value',
- 'h' => '~Holding Period',
- 'R' => 'Annual Re~turn',
- 'd' => '~Drawdown',
- 'e' => '~Earnings per Share',
- 'P' => 'P~rice Earnings Ratio',
- 'D' => 'Di~vidend Yield',
- 'm' => '~Market Captialization',
- 'f' => '~FilePosition'
- );
- foreach (qw/s n l a r V p v h R d e P D m f/) {
- $CasX->checkbutton(-label => $colbutton_text{$ARG},
- -variable => \$coldisp{$ARG},
- -command => \&update_display);
- }
- my $CasS = $M[1]->cascade(-label => '~Sort');
- my %sortbutton_text = ('n' => '~Name',
- 'r' => '~Relative Change',
- 'a' => '~Absolute Change',
- 'p' => 'Position ~Change',
- 'v' => '~Position Value',
- 'V' => '~Volume Traded',
- 'h' => '~Holding Period',
- 'R' => 'Annual Re~turn',
- 'd' => '~Drawdown',
- 'e' => '~Earnings per Share',
- 'P' => 'P~rice Earnings Ratio',
- 'D' => 'Di~vidend Yield',
- 'm' => '~Market Captialization',
- 'f' => '~FilePosition');
- foreach (qw/n r a p v V h R d e P D m f/) {
- $CasS->radiobutton(-label => $sortbutton_text{$ARG},
- -command => \&update_display,
- -variable => \$options{sort},
- -value => $ARG);
- }
- $M[1]->AddItems(["command" => "Change ~Update Delay",
- -command => \&chg_delay]);
- $M[1]->AddItems(["command" => "Update ~Now",
- -command => \&update_display_variables]);
- $M[1]->checkbutton(-label => "~Wide window title",
- -variable => \$options{wide},
- -command => \&update_display);
- $M[1]->checkbutton(-label => "~Percent instead of bps",
- -variable => \$options{percent},
- -command => \&update_display);
- $M[1]->checkbutton(-label => "Susp~end updates",
- -variable => \$options{paused});
- $M[2] = $MF->Menubutton(-text => 'Charts', -underline => 0,
- )->pack(-side => 'left');
- my $CasC = $M[2]->cascade(-label => "~Timeframe");
- my %radiobutton_text = ('t' => 'Weekly Thumbnail',
- 'b' => '~Intraday',
- 'w' => '~Weekly',
- '3' => '~Three months',
- '6' => '~Six months',
- '1' => '~One year',
- '2' => 'Two ~years',
- '5' => '~Five years',
- 'm' => '~Max years');
- foreach (qw/t b w 3 6 1 2 5 m/) {
- $CasC->radiobutton(-label => $radiobutton_text{$ARG},
- -variable => \$chart{length}, -value => $ARG);
- }
- my $CasPS = $M[2]->cascade(-label => "Plot ~Size");
- my %radiobutton_ps = ('s' => '~Small',
- 'm' => '~Medium',
- 'l' => '~Large');
- foreach (qw/s m l/) {
- $CasPS->radiobutton(-label => $radiobutton_ps{$ARG},
- -variable => \$chart{size}, -value => $ARG);
- }
- my $CasPT = $M[2]->cascade(-label => "Plot T~ype");
- my %radiobutton_pt = ('l' => '~Line chart',
- 'b' => '~Bar chart',
- 'c' => '~Candle chart');
- foreach (qw/l b c/) {
- $CasPT->radiobutton(-label => $radiobutton_pt{$ARG},
- -variable => \$chart{style}, -value => $ARG);
- }
- my $CasMA = $M[2]->cascade(-label => '~Moving Averages');
- my %mabutton_text = ('5' => '5 days',
- '10' => '10 days',
- '20' => '20 days',
- '50' => '50 days',
- '100' => '100 days',
- '200' => '200 days');
- foreach (qw/5 10 20 50 100 200/) {
- $CasMA->checkbutton(-label => $mabutton_text{$ARG},
- -variable => \$chart{ma}{$ARG});
- }
- my $CasEMA = $M[2]->cascade(-label => '~Exp. Moving Avg.');
- foreach (qw/5 10 20 50 100 200/) {
- $CasEMA->checkbutton(-label => $mabutton_text{$ARG},
- -variable => \$chart{ema}{$ARG});
- }
- my $CasTA = $M[2]->cascade(-label => 'Te~chnical Analysis');
- # see http://help.yahoo.com/help/us/fin/chart/chart-12.html
- my %ta_text = ('m26_12_9' => 'MACD (MA Conv./Divergence)',
- 'f14' => 'MFI (Money Flow)',
- 'p12' => 'ROC (Rate of Change)',
- 'r14' => 'RSI (Relative Strength Index)',
- 'ss' => 'Stochastic (slow)',
- 'fs' => 'Stochastic (fast)',
- 'w14' => 'Williams %R');
- foreach (sort {$ta_text{$a} cmp $ta_text{$b}} keys %ta_text) {
- $CasTA->checkbutton(-label => $ta_text{$ARG},
- -variable => \$chart{technical}{$ARG});
- }
- $M[2]->checkbutton(-label => "~Logarithmic scale",
- -variable => \$chart{log_scale});
- $M[2]->checkbutton(-label => "~Volume and its MA",
- -variable => \$chart{volume});
- $M[2]->checkbutton(-label => "~Bollinger Bands",
- -variable => \$chart{bollinger});
- $M[2]->checkbutton(-label => "~Parabolic SAR",
- -variable => \$chart{parabolic_sar});
- $M[2]->AddItems(["command" => "Enter ~Comparison Symbol(s)",
- -command => \&get_comparison_symbol]);
- $M[2]->checkbutton(-label => "Chart ~Gallery",
- -variable => \$options{gallery},
- -command => \&show_gallery);
- $M[3] = $MF->Menubutton(-text => 'Help', -underline => 0,
- )->pack(-side => 'right');
- $M[3]->AddItems(["command" => "~Manual", -command => \&help_about]);
- $M[3]->AddItems(["command" => "~License", -command => \&help_license]);
- $Main->configure(-title => "smtm"); # this will be overridden later
- $Main->resizable(0,0); # don't allow width or height resizing
- $Main->iconname("smtm");
- }
- sub buttons { # create all display buttons
- @{$Dat{NA}} = sort @{$Dat{Arg}};
- $Main->resizable(1,1);
- $BFrame->destroy() if Tk::Exists($BFrame);
- $BFrame = $Main->Frame()->pack(-side=>'top', -fill=>'x');
- $BFrame->Label->repeat($options{delay}*1000*60,
- \&update_display_variables);
- $Header->destroy() if Tk::Exists($Header);
- $Header = $BFrame->Label(-anchor => 'w',
- -font => $BFont,
- -borderwidth => 3,
- -relief => 'groove',
- -textvariable => \$headertext,
- )->pack(-side => 'top', -fill => 'x');
- my $balloon = $BFrame->Balloon();
- foreach (0..$#{$Dat{Arg}}) { # set up the buttons
- $Buttons[$ARG]->destroy() if Tk::Exists($Buttons[$ARG]);
- $Buttons[$ARG] = $BFrame->Button(-command => [\&show_details, $ARG],
- -font => $BFont,
- -relief => 'flat',
- -borderwidth => -4,
- -textvariable => \$Labels[$ARG]
- )->pack(-side => 'top',
- -fill => 'x');
- $Buttons[$ARG]->bind("<Button-2>", [\&edit_stock, $ARG]);
- $Buttons[$ARG]->bind("<Button-3>", [\&view_image, $ARG]);
- $balloon->attach($Buttons[$ARG],
- -balloonmsg => "Mouse-1 for details, " .
- "Mouse-2 to edit, ".
- "Mouse-3 for chart");
- }
- $Main->resizable(0,0);
- # are we dealing with firewalls, and do we need to get the info ?
- if (defined($options{firewall}) and
- ($options{firewall} eq "" or $options{firewall} !~ m/.*:.*/)) {
- get_firewall_id(); # need to get firewall account + password
- } else {
- update_display_variables(); # else populate those buttons
- }
- }
- sub sort_func { # sort shares for display
- my @a = split /;/, $a;
- my @b = split /;/, $b;
- if ($options{sort} eq 'r') { # do we sort by returns (relative change)
- my $achg = $Dat{Bps}{$a[0]} || 0;
- my $bchg = $Dat{Bps}{$b[0]} || 0;
- if (defined($achg) and defined($bchg)) {
- return $bchg <=> $achg # apply descending (!!) numerical comparison
- || $a[1] cmp $b[1] # with textual sort on names to break ties
- } else {
- return $a[1] cmp $b[1]; # or default to textual sort on names
- }
- } elsif ($options{sort} eq 'a') { # do we sort by absolute change
- return $b[5] <=> $a[5]
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'p') { # do we sort by profit/loss amount
- return $Dat{PLContr}{$b[0]} <=> $Dat{PLContr}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'v') { # do we sort by profit/loss amount
- return $Dat{Value}{$b[0]} <=> $Dat{Value}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'V') { # do we sort by volume traded
- return $b[7] <=> $a[7]
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'h') { # do we sort by days held
- return $Dat{DaysHeld}{$b[0]} <=> $Dat{DaysHeld}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'R') { # do we sort by annual return
- return $Dat{Return}{$b[0]} <=> $Dat{Return}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'd') { # sort by drawdown
- my $a = defined($Dat{Drawdown}{$a[0]}) ? $Dat{Drawdown}{$a[0]} : 0;
- my $b = defined($Dat{Drawdown}{$b[0]}) ? $Dat{Drawdown}{$b[0]} : 0;
- return $b <=> $a || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'e') {
- return $Dat{EPS}{$b[0]} <=> $Dat{EPS}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'P') {
- return $Dat{PE}{$b[0]} <=> $Dat{PE}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'D') {
- return $Dat{DivYield}{$b[0]} <=> $Dat{DivYield}{$a[0]}
- || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'm') {
- my $a = $Dat{MarketCap}{$a[0]} ne "N/A" ? $Dat{MarketCap}{$a[0]} : 0;
- my $b = $Dat{MarketCap}{$b[0]} ne "N/A" ? $Dat{MarketCap}{$b[0]} : 0;
- return $b <=> $a || $a[1] cmp $b[1] # or default to textual sort on names
- } elsif ($options{sort} eq 'f') { # ordered by file position
- return $Dat{ID}{$a[0]} <=> $Dat{ID}{$b[0]}
- } else { # alphabetical sort
- return $a[1] cmp $b[1];
- }
- }
- sub update_display_variables { # gather data, and update display strings
- if (not $options{paused}) {
- update_data(); # fetch the data from the public servers
- compute_positions(); # update position hashes
- update_display(); # and update the ticker display
- show_gallery() if $options{gallery};
- }
- }
- sub update_data { # gather data from Yahoo! servers
- $today = ParseDate("today"); # current time and date for return calculations
- my $count = 0; # count 'defined' elements in Dat{FXarr}
- foreach my $val ($Dat{FXarr}) { $count++ if defined($val)};
- if ($count > 0) { # if there are cross-currencies
- my $array = getquote(@{$Dat{FXarr}}); # get FX crosses
- foreach my $ra (@$array) {
- next unless $ra->[0];
- $ra->[0] =~ s/\=X//; # reduce back to pure cross symbol
- $Dat{FX}{uc $ra->[0]} = $ra->[2]; # and store value in FX hash
- }
- }
- undef $Dat{Data};
- # NA: name,symbol,price,last date (m/d/y),time,change,percent,volume,avg vol,
- # bid, ask, previous,open,day range,52 week range,eps,p/e,
- # div pay date,annual div amt, divyld, cap
- if (scalar(@{$Dat{NA}})>-1) { # if there are stocks for Yahoo! North America
- fill_with_dummies(@{$Dat{NA}});
- ## call just as the symbol, i.e. without the number key past ':'
- my @syms = map { (split(/:/, $ARG))[0]} @{$Dat{NA}};
- my $array = getquote(@syms); # get North American quotes
- my $i=0;
- foreach my $ra (@$array) {
- $ra->[0] = @{$Dat{NA}}[$i++]; # store with supplied symbol + key
- $Dat{Data}{uc $ra->[0]} = join(";", @$ra); # store all info
- }
- }
- }
- # As getquote() may return empty, we have to intialize the %Dat hash
- # so that later queries don't hit a void
- sub fill_with_dummies {
- my (@arr) = @_;
- foreach $ARG (@arr) {
- $Dat{Data}{uc $ARG} = join(";", (uc $ARG, "-- N/A --",
- 0, "1/1/1970", "00:00", 0, "0.00%",
- 0, "-", "-", "-", "-", "-",
- "-", "-", "-", "-", "-", "-", "-"));
- }
- }
- # Use the name supplied from Yahoo!, unless there is a user-supplied
- # GivenName in the rc file. In case we have data problems, return N/A
- sub get_pretty_name {
- my ($pretty, $default) = @_;
- if (not defined($pretty) or $pretty eq "" or $default eq "-- N/A --") {
- return $default;
- } else {
- return $pretty;
- }
- }
- sub compute_positions {
- undef %{$Dat{Price}};
- undef %{$Dat{Change}};
- undef %{$Dat{Bps}};
- undef %{$Dat{PLContr}};
- undef %{$Dat{Value}};
- undef %{$Dat{Volume}};
- undef %{$Dat{Return}};
- undef %{$Dat{DaysHeld}};
- # We have to loop through once to compute all column entries, and to store
- # them so that we can find the largest each to compute optimal col. width
- foreach (values %{$Dat{Data}}) {
- my @arr = split (';', $ARG);
- my $symbol = uc $arr[0];
- $Dat{Name}{$symbol} = $arr[1] || "-- No connection";
- $Dat{Price}{$symbol} = $arr[2] || 0;
- $Dat{Change}{$symbol} = $arr[5] || 0;
- $Dat{Change}{$symbol} = 0 if $Dat{Change}{$symbol} eq "N/A";
- my $pc = $arr[6] || "0.00%";
- $pc =~ s/\%//; # extract percent change
- $pc = 0 if $pc eq "N/A";
- my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
- my $shares = $Dat{Shares}{$symbol} || 0;
- $Dat{Bps}{$symbol} = 100*$pc * ($shares < 0 ? -1 : 1);
- my $plcontr = $shares * $Dat{Change}{$symbol} * $fx;
- $Dat{PLContr}{$symbol} = $plcontr;
- my $value = $shares * $Dat{Price}{$symbol} * $fx;
- $Dat{Value}{$symbol} = $value;
- $Dat{Volume}{$symbol} = $arr[7] || 0;
- ($Dat{YearLow}{$symbol}, $Dat{YearHigh}{$symbol}) = (undef, undef);
- ($Dat{YearLow}{$symbol}, $Dat{YearHigh}{$symbol}) = split / - /, $arr[14];
- if (defined($Dat{YearHigh}{$symbol})
- and $Dat{YearHigh}{$symbol} ne "N/A"
- and $Dat{YearHigh}{$symbol} != 0) {
- $Dat{Drawdown}{$symbol}
- = 100.0*($Dat{Price}{$symbol}/$Dat{YearHigh}{$symbol}-1.0);
- } else {
- $Dat{Drawdown}{$symbol} = undef;
- }
- if ($Dat{PurchPrice}{$symbol} and $Dat{PurchDate}{$symbol}) {
- $Dat{DaysHeld}{$symbol} =
- Delta_Format(DateCalc($Dat{PurchDate}{$symbol},
- $today, undef, 2), 0, "%dt");
- if ( $Dat{DaysHeld}{$symbol} > 365 ) {
- $Dat{Return}{$symbol} = ($Dat{Price}{$symbol} /
- $Dat{PurchPrice}{$symbol} - 1) * 100
- * 365 / $Dat{DaysHeld}{$symbol}
- * ($shares < 0 ? -1 : 1);
- } else { # don't annualize
- $Dat{Return}{$symbol} = ($Dat{Price}{$symbol} /
- $Dat{PurchPrice}{$symbol} - 1) * 100
- * ($shares < 0 ? -1 : 1);
- }
- } else {
- $Dat{DaysHeld}{$symbol} = undef;
- $Dat{Return}{$symbol} = undef;
- }
- $Dat{EPS}{$symbol} = $arr[15] || 0;
- $Dat{PE}{$symbol} = $arr[16] || 0;
- $Dat{DivDate}{$symbol} = $arr[17] || 0;
- $Dat{DivAmount}{$symbol} = $arr[18] || 0;
- $Dat{DivYield}{$symbol} = $arr[19] || 0;
- $Dat{MarketCap}{$symbol} = "N/A"; # default to NA
- if (defined($arr[20]) and # need to regularise oddball market string
- $arr[20] ne "N/A") {
- # before the dot, the dot, first decimal, remaining decimal, units
- my ($pre,$p1,$p2,$s) = ($arr[20] =~ m/(\d*)\.(\d)(\d*)(B|M|K)$/);
- #print "$arr[20] -> $pre DOT $p1 $p2 $s\n";
- $Dat{MarketCap}{$symbol} = "$pre" . "." . $p1 . $s
- if defined($p1) and defined($s);
- }
- foreach ("EPS","PE", "DivYield") {
- $Dat{$ARG}{$symbol} = 0 if $Dat{$ARG}{$symbol} eq "N/A";
- }
- }
- }
- sub update_display {
- my $pl = 0; # profit/loss counter
- my $nw = 0; # networth counter
- my $shares = 0; # net shares positions
- my $max_sym = 0;
- foreach my $key (keys %{$Dat{Symbol}}) {
- $max_sym = length($key) if (length($key) > $max_sym);
- }
- my $max_len = 0;
- foreach my $key (keys %{$Dat{Name}}) {
- my $txt = get_pretty_name($Dat{GivenName}{$key}, $Dat{Name}{$key})
- || "-- No connection";
- $txt =~ s/\s*$//; # eat trailing white space, if any
- my $len = length($txt) > 16 ? 16 : length($txt);
- $max_len = $len if ($len > $max_len);
- }
- my $max_price = 0;
- foreach my $val (values %{$Dat{Price}}) {
- $max_price = $val if ($val > $max_price);
- }
- my $max_change = 0.01; # can't take log of zero below
- my $min_change = 0.01;
- foreach my $val (values %{$Dat{Change}}) {
- $max_change = $val if ($val > $max_change);
- $min_change = $val if ($val < $min_change);
- }
- my $max_bps = 1; # can't take log of zero below
- my $min_bps = 1;
- foreach my $val (values %{$Dat{Bps}}) {
- $max_bps = $val if ($val > $max_bps);
- $min_bps = $val if ($val < $min_bps);
- }
- my $max_plc = 1; # can't take log of zero below
- my $min_plc = 1;
- foreach my $val (values %{$Dat{PLContr}}) {
- $max_plc = $val if ($val > $max_plc);
- $min_plc = $val if ($val < $min_plc);
- }
- my $max_value = 1; # can't take log of zero below
- foreach my $val (values %{$Dat{Value}}) {
- $max_value = $val if ($val > $max_value);
- }
- my $max_volume = 1; # can't take log of zero below
- foreach my $val (values %{$Dat{Volume}}) {
- $max_volume = $val if (($val ne "N/A") and ($val > $max_volume));
- }
- my $max_held = 0; #
- foreach my $val (values %{$Dat{DaysHeld}}) {
- $max_held = $val if (defined($val) and $val > $max_held);
- }
- my $max_ret = 0; #
- my $min_ret = 0; #
- foreach my $val (values %{$Dat{Return}}) {
- $max_ret = $val if (defined($val) and $val > $max_ret);
- $min_ret = $val if (defined($val) and $val < $min_ret);
- }
- my $max_ddown = 0;
- foreach my $val (values %{$Dat{Drawdown}}) {
- $max_ddown = $val if (defined($val) and $val < $max_ddown);
- }
- my $max_eps = 0;
- my $min_eps = 0; #
- foreach my $val (values %{$Dat{EPS}}) {
- $max_eps = $val if (defined($val) and $val ne "-"
- and $val ne "N/A" and $val > $max_eps);
- $min_eps = $val if (defined($val) and $val ne "-"
- and $val ne "N/A" and $val < $min_eps);
- }
- my $max_pe = 0;
- foreach my $val (values %{$Dat{PE}}) {
- $max_pe = $val if (defined($val) and $val ne "-"
- and $val ne "N/A" and $val > $max_pe);
- }
- my $max_divyld = 0;
- foreach my $val (values %{$Dat{DivYield}}) {
- $max_divyld = $val if (defined($val) and $val ne "-" and $val ne "N/A"
- and $val > $max_divyld);
- }
- my $max_mktcap = 0;
- foreach my $val (values %{$Dat{MarketCap}}) {
- my $nval = $val;
- $nval =~ s/(B|M|K)$//;
- $max_mktcap = $nval if (defined($nval) and $nval ne "N/A"
- and $nval ne "-" and $nval > $max_mktcap);
- }
- my $max_fpos = 0;
- foreach my $val (values %{$Dat{ID}}) {
- $max_fpos = $val if (defined($val) and $val > $max_fpos);
- }
- # transform as necessary
- $max_price = 3 + digits($max_price); # dot and two digits
- $max_change = 3 + max(digits($max_change), digits($min_change));
- $max_bps = max(3+$options{percent}, max(digits($max_bps),digits($min_bps)));
- $max_plc = max(3, max(digits($max_plc),digits($min_plc)));
- $max_value = max(3, digits($max_value));
- $max_volume = digits($max_volume);
- $max_ret = 2 + max(digits($max_ret),digits($min_ret));
- $max_held = max(3, digits($max_held));
- $max_ddown = 2 + max(2, 1+digits(-$max_ddown)); # 1 decimals,dot,minus,digitb
- $max_eps = 2 + max(digits($max_eps),digits($min_eps));
- $max_pe = 2 + digits($max_pe);
- $max_divyld = 2 + digits($max_divyld);
- $max_mktcap = 3 + digits($max_mktcap);
- $max_fpos = max(2, digits($max_fpos));
- $headertext = "";
- $headertext .= "Sym " . " " x ($max_sym-3) if $coldisp{s};
- $headertext .= "Name " . " " x ($max_len-4) if $coldisp{n};
- # $headertext .= " "; # transition from leftflush to rightflush
- $headertext .= " " x ($max_price-4) . "Last " if $coldisp{l};
- $headertext .= " " x ($max_change-3) . "Chg " if $coldisp{a};
- $headertext .= " " x ($max_bps-4) . "%Chg "
- if $coldisp{r} and $options{percent};
- $headertext .= " " x ($max_bps-3) . "Bps "
- if $coldisp{r} and not $options{percent};
- $headertext .= " " x ($max_volume-3) . "Vol " if $coldisp{V};
- $headertext .= " " x ($max_plc-3) . "P/L " if $coldisp{p};
- $headertext .= " " x ($max_value-3) . "Net " if $coldisp{v};
- $headertext .= " " x ($max_held-3) . "Len " if $coldisp{h};
- $headertext .= " " x ($max_ret-3) . "Ret " if $coldisp{R};
- $headertext .= " " x ($max_ddown - 4) . "Ddwn " if $coldisp{d};
- $headertext .= " " x ($max_eps - 3) . "EPS " if $coldisp{e};
- $headertext .= " " x ($max_pe - 2) . "PE " if $coldisp{P};
- $headertext .= " " x ($max_divyld - 3) . "Yld " if $coldisp{D};
- $headertext .= " " x ($max_mktcap - 3) . "Cap " if $coldisp{m};
- $headertext .= "FP " if $coldisp{f};
- chop $headertext; # get trailing ' '
- print "$headertext\n" if $options{verbose};
- # Now apply all that information to the display
- my $i = 0;
- foreach (sort sort_func values %{$Dat{Data}}) {
- my @arr = split (';', $ARG);
- my $symbol = uc $arr[0];
- my $name = get_pretty_name($Dat{GivenName}{$symbol},
- $Dat{Name}{$symbol}) || "-- No connection";
- if (not defined $Dat{Bps}{$symbol}) {
- $Buttons[$i]->configure(-foreground => 'white',
- -activeforeground => 'white');
- } elsif ($Dat{Bps}{$symbol} < 0) { # if we're losing money on this one
- $Buttons[$i]->configure(-foreground => 'red',
- -activeforeground => 'red');
- } else {
- $Buttons[$i]->configure(-foreground => 'black',
- -activeforeground => 'black');
- }
- $Labels[$i] = "";
- $Labels[$i] .= sprintf("%*s ", -$max_sym, $Dat{Symbol}{$symbol})
- if $coldisp{s};
- $Labels[$i] .= sprintf("%*s ", -$max_len, substr($name,0,$max_len))
- if $coldisp{n};
- $Labels[$i] .= sprintf("%$max_price.2f ", $Dat{Price}{$symbol})
- if $coldisp{l};
- $Labels[$i] .= sprintf("%$max_change.2f ", $Dat{Change}{$symbol})
- if $coldisp{a};
- $Labels[$i] .= sprintf("%$max_bps.0f ", $Dat{Bps}{$symbol})
- if $coldisp{r} and not $options{percent};
- $Labels[$i] .= sprintf("%" . ($max_bps + 1) . ".2f ",
- ($Dat{Bps}{$symbol}) / 100)
- if $coldisp{r} and $options{percent};
- $Labels[$i] .= sprintf("%$max_volume.0d ",
- ($Dat{Volume}{$symbol} ne "N/A"
- ? $Dat{Volume}{$symbol} : 0))
- if $coldisp{V};
- $Labels[$i] .= sprintf("%$max_plc.0f ", $Dat{PLContr}{$symbol})
- if $coldisp{p};
- $Labels[$i] .= sprintf("%$max_value.0f ", $Dat{Value}{$symbol})
- if $coldisp{v};
- if ($coldisp{h}) {
- if (defined($Dat{DaysHeld}{$symbol})) {
- $Labels[$i] .= sprintf("%$max_held.0f ", $Dat{DaysHeld}{$symbol});
- } else {
- $Labels[$i] .= sprintf("%*s ", $max_held, "NA");
- }
- }
- if ($coldisp{R}) {
- if (defined($Dat{Return}{$symbol})) {
- $Labels[$i] .= sprintf("%$max_ret.1f ", $Dat{Return}{$symbol});
- } else {
- $Labels[$i] .= sprintf("%*s ", $max_ret, "NA");
- }
- }
- if ($coldisp{d}) { # drawdown
- if (defined($Dat{Drawdown}{$symbol})) {
- $Labels[$i] .= sprintf("%$max_ddown.1f ", $Dat{Drawdown}{$symbol});
- } else {
- $Labels[$i] .= sprintf("%*s ", $max_ddown, "NA");
- }
- }
- $Labels[$i] .= sprintf("%$max_eps.1f ", $Dat{EPS}{$symbol})
- if $coldisp{e};
- $Labels[$i] .= sprintf("%$max_pe.1f ", $Dat{PE}{$symbol})
- if $coldisp{P};
- $Labels[$i] .= sprintf("%$max_divyld.1f ", $Dat{DivYield}{$symbol})
- if $coldisp{D};
- if ($coldisp{m}) {
- if ($Dat{MarketCap}{$symbol} ne "N/A") {
- $Labels[$i] .= sprintf("%*s ", $max_mktcap, $Dat{MarketCap}{$symbol});
- } else {
- $Labels[$i] .= sprintf("%*s ", $max_mktcap, "NA");
- }
- }
- $Labels[$i] .= sprintf("%$max_fpos.0f ", $Dat{ID}{$symbol})
- if $coldisp{f};
- chop $Labels[$i];
- print "$Labels[$i]\n" if $options{verbose};
- $nw += $Dat{Value}{$symbol};
- $pl += $Dat{PLContr}{$symbol};
- $Dat{Map}[$i++] = $symbol;
- }
- my $bps = $nw - $pl != 0 ? 100*100*($pl/($nw-$pl)) : 0;
- my $txt = ($options{percent} ?
- sprintf("%.2f%%", $bps / 100) : sprintf("%.0f Bps", $bps))
- . " at " . POSIX::strftime("%H:%M", localtime);
- $txt = $txt . sprintf(" p/l %.0f net %.0f", $pl, $nw) if ($options{wide});
- $Main->configure(-title => $txt);
- $Main->iconname($txt); # also set the icon name
- }
- sub digits { # calculate nb of digits sprintf will need
- my $x = shift;
- my $count = 0;
- $count = $x =~ s/[BKM]$//;
- # rounded(log10(0.5) gives 0 even though this has 1 leading decimal
- $x *= 10 if (abs($x) > 0 and abs($x) < 1);
- $x *= 10 if ($x<0); # add one for minus sign
- $x = abs($x) if ($x < 0); # need absolute value of neg. values
- if ($x != 0) {
- return int(log($x)/log(10)+1) + $count;# this gives the rounded log10 of x
- } else {
- return 1;
- }
- }
- sub max {
- my ($a,$b) = @_;
- $a > $b ? return $a : $b;
- }
- sub show_details { # display per-share details
- my $key = shift;
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->resizable(0,0); # no resizing
- my (@text) = ("Symbol", "Name", "Price", "Date", "Time", "Change",
- "Percent. Change", "Volume", "Average Volume",
- "Bid", "Ask", "Previous", "Open", "Day Range",
- "52 Week Range", "Earnings/Share", "Price/Earnings",
- "Dividend Date", "Dividend Amount", "Dividend Yield",
- "Market Capital");
- my $Text = $TL->Text(-height => 1 + $#text + 7, # 7 computed position values
- -width => 39,
- -font => $BFont,
- )->pack();
- my @arr = split (';', $Dat{Data}{ $Dat{Map}[$key] });
- my $symbol = $arr[0];
- $arr[0] = $Dat{Symbol}{$arr[0]};
- $arr[1] = substr(get_pretty_name($Dat{GivenName}{$symbol},
- $Dat{Name}{$symbol}) || "-- No connection",
- 0, 22);
- $TL->title("Details for $arr[1]");
- foreach (0..$#text) {
- $Text->insert('end', sprintf("%-16s %s\n", $text[$ARG], $arr[$ARG]));
- }
- my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
- my $shares = $Dat{Shares}{$symbol} || 0;
- $Text->insert('end',
- sprintf("%-16s %d\n%-16s %.2f\n%-16s %.2f\n",
- "Shares Held", $shares,
- "Value Change", $shares * $Dat{Change}{$symbol} * $fx,
- "Total Value", $shares * $Dat{Price}{$symbol} * $fx));
- $Text->insert('end', sprintf("%-16s %s\n", "Days Held",
- defined($Dat{DaysHeld}{$symbol}) ?
- sprintf("%d years and %d days",
- $Dat{DaysHeld}{$symbol}/365,
- $Dat{DaysHeld}{$symbol} % 365) : "NA"));
- $Text->insert('end', sprintf("%-16s %s\n", "Purchase Price",
- $Dat{PurchPrice}{$symbol} ?
- sprintf("%.2f",$Dat{PurchPrice}{$symbol}) : "NA"));
- if ( $shares != 0 ) {
- my $fx = $Dat{FX}{ $Dat{Cross}{$symbol} } || 1;
- my $gl = ($Dat{Price}{$symbol} - $Dat{PurchPrice}{$symbol})
- * ($shares < 0 ? -1 : 1) * $fx;
- $Text->insert('end', sprintf("%-16s %s\n", "Profit or Loss",
- sprintf("%.2f", $gl * $shares)));
- } else {
- $Text->insert('end', sprintf("%-16s %s\n", "Profit or Loss", "NA"));
- }
- if ( defined($Dat{Return}{$symbol}) && $Dat{DaysHeld}{$symbol} > 365 ) {
- $Text->insert('end', sprintf("%-16s %s\n", "Annual. Return",
- defined($Dat{Return}{$symbol}) ?
- sprintf("%.2f%%",
- $Dat{Return}{$symbol}) : "NA"));
- } else {
- $Text->insert('end', sprintf("%-16s %s\n", "YTD Return",
- defined($Dat{Return}{$symbol}) ?
- sprintf("%.2f%%",
- $Dat{Return}{$symbol}) : "NA"));
- }
- button_or_mouseclick_close($TL,$Text);
- }
- sub button_or_mouseclick_close {
- my ($A,$B) = @_;
- if ($options{nookbutton}) {
- $B->bind("<Button-1>", sub { $A->destroy}); # also close on Button-1
- } else {
- $A->Button(-text => 'Ok',
- -command => sub { $A->destroy(); } )->pack(-side => 'bottom');
- }
- }
- sub add_image_close_button($$) {
- my ($arg, $new) = @_;
- if ($options{nookbutton}) {
- $Dat{Label}[$arg]->bind("<Button-1>",
- sub {
- $Dat{Image}[$arg]->delete;
- $Dat{Chart}[$arg]->destroy();
- delete $Dat{Chart}[$arg]
- or die "Cannot delete chart\n";
- delete $Dat{Image}[$arg]
- or die "Cannot delete image\n";
- delete $Dat{Label}[$arg]
- or die "Cannot delete label\n";
- });
- } elsif ($new) {
- $Dat{Chart}[$arg]->Button(-text => 'Ok',
- -command => sub {
- $Dat{Image}[$arg]->delete;
- $Dat{Chart}[$arg]->destroy();
- delete $Dat{Chart}[$arg]
- or die "Cannot delete chart\n";
- delete $Dat{Image}[$arg]
- or die "Cannot delete image\n";
- delete $Dat{Label}[$arg]
- or die "Cannot delete label\n";
- },
- )->pack(-side => 'bottom')
- or die "Cannot create button\n";
- }
- }
- sub view_image {
- my ($widget,$arg) = @_;
- my @arr = split (';', $Dat{Data}{ $Dat{Map}[$arg] });
- my $url = charturl(lc( $Dat{Symbol}{$arr[0]} ));
- my $ua = LWP::UserAgent->new;
- $ua->env_proxy;
- $ua->proxy('http', $options{proxy}) if $options{proxy};
- $ua->timeout($options{timeout}); # time out after this many secs
- my $resp = $ua->request(GET $url);
- if ($resp->is_error) { # error in retrieving the chart;
- my $new = 0; # by default we renew
- my ($TL, $PH);
- if (!exists($Dat{Chart}[$arg])) {
- $Dat{Chart}[$arg] = $Main->Toplevel; # new toplevel widget ...
- $new = 1; # remember that this is a first
- }
- $TL = $Dat{Chart}[$arg]; # most likely 404 (not found);
- #$TL->resizable(0,0); # no resizing
- $TL->title ("Error"); # Yahoo returns HTML, not a NULL,
- $Dat{Chart}[$arg] = $TL; # store for later update
- my $Text = $TL->Label(-padx =>5, # so need to check return code
- -pady =>5,
- -text =>"The chart for $arr[1] is not available."
- )->pack;
- $Dat{Label}[$arg] = $Text; # store the label
- $Dat{Photo}[$arg] = "placeholder"; # and an image placeholder
- add_image_close_button($arg, $new);
- } else {
- my $new = 0; # by default we renew
- my ($TL, $PH);
- if (!exists($Dat{Chart}[$arg])) {
- $Dat{Chart}[$arg] = $Main->Toplevel; # new toplevel widget ...
- $new = 1; # remember that this is a first
- }
- ## test if Tk object still Exists as users may have killed it
- if (defined($Dat{Chart}[$arg]) and Exists($Dat{Chart}[$arg])) {
- $Dat{Chart}[$arg]->title("Graph for $arr[1] at " .
- POSIX::strftime("%H:%M", localtime));
- $TL = $Dat{Chart}[$arg];
- #$TL->resizable(0,0); # no resizing
- if (exists($Dat{Image}[$arg])) { # if we have a previous image
- $Dat{Image}[$arg]->delete; # delete it (to reclaim memory)
- }
- ## can pass the web-request response to Photo widget once base64 encoded
- $Dat{Image}[$arg] = $TL->Photo(-data => encode_base64($resp->content),
- ## as of May 2005, png is used -format => "gif");
- -format => "png");
- $PH = $Dat{Image}[$arg];
- if (exists($Dat{Label}[$arg])) { # if we have a previous label
- $Dat{Label}[$arg]->destroy(); # destroy it (to make new one visible)
- }
- $Dat{Label}[$arg] = $TL->Label(-image => $PH)->pack();
- ##
- add_image_close_button($arg, $new);
- }
- }
- }
- sub charturl { # initially (almost) verbatim from Dj's
- my $symbol = shift; # YahooChart, now completely rewritten
- my $url; # and very significantly extended
- my $len = $chart{length};
- if ($len =~ m/t/o) { # if 'm' for thumbnail
- $url = "http://ichart.yahoo.com/v?s=$symbol"; ## really small
- } elsif ($len =~ m/(b|w)/o) { # if 'b' or 'w' for intra-day or 5 day
- ## next line no longer needed, IIRC we once used i for what we now use b
- ##$len = 'b' if $len eq 'i'; # intraday chart uses Yahoo! code 'b'
- $url = "http://ichart.yahoo.com/$len?s=$symbol";
- #$url = "http://ichart.yahoo.com/v?s=$symbol"; ## really small
- } else { # everything else, ie three month onwards
- $len .= 'y' if $len=~ m/(1|2|5|m)/o;# code for year is '1y' ... 'my'
- $len .= 'm' if $len =~ m/(3|6)/o; # code for month is '3m' or '6m'
- my $params = "s"; # always set splits
- foreach (keys %{$chart{ma}}) { # for all possible moving avg options
- $params .= ",m$ARG" if $chart{ma}{$ARG};
- }
- foreach (keys %{$chart{ema}}){ # for all possible exp. mov avg options
- $params .= ",e$ARG" if $chart{ema}{$ARG};
- }
- $params .= ",b" if $chart{bollinger}; # maybe set Bollinger Bands
- $params .= ",p" if $chart{parabolic_sar}; # maybe set Parabolic SAR
- my $log = $chart{log_scale} ? "on" : "off"; # maybe switch to log scale
- my $pane = $chart{volume} ? "vm" : ""; # maybe add volume on new pane
- foreach (keys %{$chart{technical}}) { # for all tech. analysis opt.
- $pane .= ",$ARG" if $chart{technical}{$ARG};# add on new pane if selected
- }
- #$url = "http://cchart.yimg.com/z?" .
- $url = "http://ichart.yimg.com/z?" .
- "&s=$symbol&p=$params&t=$len&c=$chart{comparison}" .
- "&l=$log&z=$chart{size}&q=$chart{style}&a=$pane";
- }
- print "URL $url\n" if $options{verbose};
- return $url;
- }
- sub default_directory {
- my $directory = File::Spec->catfile($ENV{HOME}, ".smtm");
- unless (-d $directory) {
- warn("Default directory $directory not found, creating it.\n");
- mkdir($directory, 0750) or die "Could not create $directory: $!";
- }
- return $directory;
- }
- sub select_file_and_open {
- my $selfile = $Main->getOpenFile(-defaultextension => ".smtm",
- -initialdir => default_directory(),
- -filetypes => [
- ['SMTM', '.smtm' ],
- ['All Files', '*',],
- ],
- -title => "Load an SMTM file");
- if (defined($selfile)) { # if user has hit Accept, do nothing on Cancel
- $options{file} = $selfile;
- read_config();
- init_fx();
- buttons();
- }
- }
- sub select_file_and_save {
- my $selfile = $Main->getSaveFile(-defaultextension => ".smtm",
- -initialdir => default_directory(),
- -title => "Save an SMTM file");
- if (defined($selfile)) { # if user has hit Accept, do nothing on Cancel
- $options{file} = $selfile;
- file_save();
- }
- }
- sub read_config { # get the data from the resource file
- undef $Dat{ID}; # make sure we delete the old symbols, if any
- undef $Dat{Arg}; # make sure we delete the old symbols, if any
- undef $Dat{Map}; # make sure we delete the old symbols, if any
- undef $Dat{Name}; # make sure we delete the old symbols, if any
- undef $Dat{Symbol}; # make sure we delete the old symbols, if any
- undef $Dat{GivenName}; # make sure we delete the old symbols, if any
- undef $Dat{Shares}; # make sure we delete the old symbols, if any
- undef $Dat{Cross}; # make sure we delete the old symbols, if any
- undef $Dat{PurchPrice}; # make sure we delete the old symbols, if any
- undef $Dat{PurchDate}; # make sure we delete the old symbols, if any
- open (FILE, "<$options{file}") or die "Cannot open $options{file}: $!\n";
- while (<FILE>) { # loop over all lines in the file
- next if (m/(\#|%)/); # ignore comments, if any
- next if (m/^\s*$/); # ignore empty lines, if any
- next if (m/.*=$/); # ignore non-assignments
- if (m/^\s*\$?(\S+)=(\S+)\s*$/) { # if assignment, then it must be an option
- my ($arg,$val) = ($1,$2);
- if ($val =~ m/^X:/) { # currency symbol like GBPEUR=X
- insert_stock($ARG);
- } elsif ($arg eq "retsort") { # test for one legacy option
- $options{sort}='r' if $val; # old option $retsort was always = 1
- } elsif ($arg =~ m/chart::(\w*)/){# test for chart option
- my $key = $1;
- warn "No chart option $key known\n" unless exists($chart{$key});
- if (index($val, ":") > -1) {
- foreach (split /:/, $val) {
- my $cmd = "\$chart{$key}{$ARG}=1\n";
- print "Setting from rcfile: $cmd" if $options{verbose};
- eval $cmd; # store option
- }
- } else {
- my $cmd = "\$chart{$key}='$val'\n";
- print "Setting from rcfile: $cmd" if $options{verbose};
- eval $cmd; # store option
- }
- } else { # else normal option
- warn "No option $arg known\n" unless exists($options{$arg});
- my $cmd = "\$options{$arg}='$val'\n";
- print "Setting from rcfile: $cmd" if $options{verbose};
- eval $cmd; # store option
- }
- } else { # or else it is stock information
- insert_stock($ARG);
- }
- }
- close(FILE);
- for my $i (0..length($options{columns})-1) {
- $coldisp{substr($options{columns}, $i, 1)} = 1;
- }
- }
- sub insert_stock { # insert one stock into main data structure
- my $arg = shift;
- chomp $arg;
- my @arr = split ':', $arg; # split along ':'
- $arr[0] = uc $arr[0]; # uppercase the symbol
- my $key = $arr[0] . ':' . $symbolcounter++;
- push @{$Dat{Arg}}, $key; # store symbol
- $Dat{ID}{$key} = $symbolcounter;
- $Dat{Symbol}{$key} = defined($arr[0]) ? $arr[0] : "";
- $Dat{GivenName}{$key} = defined($arr[1]) ? $arr[1] : "";
- $Dat{Shares}{$key} = defined($arr[2]) ? $arr[2] : 0;
- $Dat{Cross}{$key} = defined($arr[3]) ? $arr[3] : "";
- $Dat{PurchPrice}{$key} = defined($arr[4]) ? $arr[4] : 0;
- $Dat{PurchDate}{$key} = defined($arr[5]) ? $arr[5] : 0;
- }
- sub edit_stock {
- my ($widget,$arg) = @_;
- my $key = $Dat{Map}[$arg];
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->title ("Edit Stock");
- $TL->resizable(0,0); # no resizing
- my $FR = $TL->Frame->pack(-fill => 'both', -fill => 'x');
- my $row = 0;
- my @data = ( $Dat{Symbol}{$key},
- $Dat{GivenName}{$key} || $Dat{Name}{$key},
- $Dat{Shares}{$key},
- $Dat{Cross}{$key},
- $Dat{PurchPrice}{$key},
- $Dat{PurchDate}{$key} );
- foreach ('Symbol', 'Name', 'Nb of Shares', 'Cross-currency',
- 'Purchase Price', 'Purchase Date') {
- my $E = $FR->Entry(-textvariable => \$data[$row],
- -relief => 'sunken', -width => 20);
- my $L = $FR->Label(-text => $ARG, -anchor => 'e', -justify => 'right');
- Tk::grid($L, -row => $row, -column => 0, -sticky => 'e');
- Tk::grid($E, -row => $row++, -column => 1, -sticky => 'ew');
- $FR->gridRowconfigure(1, -weight => 1);
- $E->focus if $ARG eq 'Symbol (required)';
- }
- $TL->Button(-text => 'Ok', -command => sub { # 0 is the symbol, not stored
- $Dat{GivenName}{$key} = defined($data[1]) ? $data[1] : "";
- $Dat{Shares}{$key} = defined($data[2]) ? $data[2] : 0;
- $Dat{Cross}{$key} = defined($data[3]) ? $data[3] : "";
- $Dat{PurchPrice}{$key} = defined($data[4]) ? $data[4] : 0;
- $Dat{PurchDate}{$key} = defined($data[5]) ? $data[5] : 0;
- $TL->destroy();
- init_fx();
- }
- )->pack(-side => 'bottom');
- }
- sub init_fx { # find unique crosscurrencies
- undef $Dat{FXarr};
- my %hash; # to compute a unique subset of the FX crosses
- foreach my $key (keys %{$Dat{Cross}}) {
- my $val = $Dat{Cross}{uc $key}; # the actual cross-currency
- if ($val ne "" and not $hash{$val}) {
- push @{$Dat{FXarr}}, $val."=X"; # store this as Yahoo's symbol
- $hash{$val} = 1; # store that's we processed it
- }
- }
- }
- sub show_gallery { # update the pictures in 'gallery' mode
- view_image($Main, $ARG) foreach (0..$#{$Dat{Arg}});
- }
- sub init_data { # fill all arguments into main data structure
- my @args = @_;
- if (defined($main::options{proxy})) {
- $Finance::YahooQuote::PROXY = $options{proxy};
- }
- if (defined($options{firewall}) and
- $options{firewall} ne "" and
- $options{firewall} =~ m/.*:.*/) {
- my @q = split(':', $main::options{firewall}, 2);
- $Finance::YahooQuote::PROXYUSER = $q[0];
- $Finance::YahooQuote::PROXYPASSWD = $q[1];
- }
- menus(); # create frame, and populate with menus
- if (defined $args[0]) { # if we had arguments
- undef $Dat{Arg}; # unset previous ones
- foreach $ARG (@args) { # and fill
- insert_stock($ARG); # new ones
- }
- }
- init_fx();
- buttons();
- }
- sub file_save { # store in resource file
- my $file = $options{file};
- open (FILE, ">$file") or die "Cannot open $file: $!\n";
- print FILE "\#\n\# smtm version $VERSION resource file saved on ",
- strftime("%c", localtime);
- print FILE "\n\#\n";
- foreach my $key (keys %options) {
- print FILE "$key=", eval("\$options{$key}"),"\n"
- if eval("defined(\$options{$key})");
- }
- foreach my $key (keys %chart) {
- # hash args get unrolled into a string joined by ':'
- if (ref($chart{$key}) and ref($chart{$key}) eq "HASH") {
- print FILE "chart::$key=";
- foreach my $chart (keys %{$chart{$key}}) {
- print FILE "$chart:" if $chart{$key}{$chart};
- }
- print FILE "\n";
- } else {
- print FILE "chart::$key=", eval("\$chart{$key}"),"\n"
- if eval("defined(\$chart{$key})");
- }
- }
- foreach (0..$#{$Dat{Arg}}) {
- my $key = @{$Dat{Arg}}[$ARG];
- print FILE join(':', ($Dat{Symbol}{$key}, $Dat{GivenName}{$key},
- $Dat{Shares}{$key}, $Dat{Cross}{$key},
- $Dat{PurchPrice}{$key},
- $Dat{PurchDate}{$key})), "\n";
- }
- close(FILE);
- }
- sub add_stock {
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->title ("Add Stock");
- $TL->resizable(0,0); # no resizing
- my $FR = $TL->Frame->pack(-fill => 'both');
- my $row = 0;
- my @data = ("", "", "", "", "", "" );
- foreach ('Symbol', 'Name', 'Nb of Shares', 'Cross-currency',
- 'Purchase Price', 'Purchase Date') {
- my $E = $FR->Entry(-textvariable => \$data[$row],
- -relief => 'sunken', -width => 20);
- my $L = $FR->Label(-text => $ARG, -anchor => 'e', -justify => 'right');
- Tk::grid($L, -row => $row, -column => 0, -sticky => 'e');
- Tk::grid($E, -row => $row++, -column => 1, -sticky => 'ew');
- $FR->gridRowconfigure(1, -weight => 1);
- $E->focus if $ARG eq 'Symbol (required)';
- }
- $TL->Button(-text => 'Ok',
- -command => sub {
- $ARG = join(':', @data);
- $TL->destroy();
- insert_stock($ARG);
- init_fx();
- buttons();
- }
- )->pack(-side => 'bottom');
- }
- sub del_stock { # delete one or several stocks
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->resizable(0,0); # no resizing
- $TL->title ("Delete Stock(s)");
- my $LB = $TL->Scrolled("Listbox",
- -selectmode => "multiple",
- -scrollbars => "e",
- -font => $BFont,
- -width => 16
- )->pack();
- my (@data); # array of symbols in displayed order
- my $prefsort = $options{sort};
- $options{sort} = 'n';
- foreach (sort sort_func values %{$Dat{Data}}) {
- my @arr = split (';', $ARG);
- $LB->insert('end', $arr[1]);
- push @data, $arr[0];
- }
- $options{sort} = $prefsort;
- $TL->Label(-text => 'Select stocks to be deleted')->pack();
- $TL->Button(-text => 'Delete',
- -command => sub {
- my @A; # temp. array
- foreach (0..$#data) {
- push @A, $data[$ARG]
- unless $LB->selectionIncludes($ARG);
- }
- @{$Dat{Arg}} = @A;
- $TL->destroy();
- buttons();
- }
- )->pack(-side => 'bottom');
- }
- sub chg_delay { # window to modify delay for update
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->resizable(0,0); # no resizing
- $TL->title ("Modify Delay");
- my $SC = $TL->Scale(-from => 1,
- -to => 60,
- -orient => 'horizontal',
- -sliderlength => 15,
- -variable => \$options{delay})->pack();
- $TL->Label(-text => 'Select update delay in minutes')->pack();
- $TL->Button(-text => 'Ok',
- -command => sub { $TL->destroy();
- buttons();
- } )->pack(-side => 'bottom');
- }
- sub get_comparison_symbol { # window to modify delay for update
- my $TL = $Main->Toplevel; # new toplevel widget ...
- $TL->resizable(0,0); # no resizing
- $TL->title ("Enter Comparison Symbol");
- my $FR = $TL->Frame->pack(-fill => 'both');
- my $data = $chart{comparison};
- my $label = 'Comparison Symbol';
- my $E = $FR->Entry(-textvariable => \$data,
- -relief => 'sunken',
- -width => 20);
- my $L = $FR->Label(-text => 'Comparison Symbol',
- -anchor => 'e',
- -justify => 'right');
- Tk::grid($L, -row => 0, -column => 0, -sticky => 'e');
- Tk::grid($E, -row => 0, -column => 1, -sticky => 'ew');
- $FR->gridRowconfigure(1, -weight => 1);
- $E->focus;
- $TL->Button(-text => 'Ok',
- -command => sub { $chart{comparison} = "$data";
- $TL->destroy();
- }
- )->pack(-side => 'bottom');
- }
- sub help_about { # show a help window
- my $TL = $Main->Toplevel; # uses pod2text on this very file :->
- $TL->resizable(0,0); # no resizi…
Large files files are truncated, but you can click here to view the full file