#!/usr/bin/perl -w 
#
#   smtm --- A global stock ticker for X11 and Windoze
#  
#   Copyright (C) 1999, 2000  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.21 2000/01/21 00:41:05 edd Exp $

use strict;			# be careful out there, my friend
use English;			# explicit variable names
use Getopt::Long;		# parse command-line arguments
use HTTP::Request::Common;	# grab data from Yahoo's web interface
use IO::File;			# needed for new_tmpfile or Tk complains
use POSIX qw(strftime tmpnam);	# strftime and tmpnam functions
use Tk;				# who needs gates in a world full o'windows?
use vars qw($file $delay $help $firewall $proxy $wide $chart $sort 
	    $nookbutton $timeout);

my $version = "0.8.2";		# updated from the debian/rules Makefile
my $date =			# inner expression updated by RCS
  sprintf("%s", q$Date: 2000/01/21 00:41:05 $ =~ /\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
    %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);
} else {
  $BFont = $Main->fontCreate(-family => 'lucidasanstypewriter', -size => 12);
}

$file = $ENV{HOME}."/.smtmrc";	# default resource file
$delay = 5;			# wait this many minutes
$chart = 'w';			# weekly chart is default chart
$sort = 'n';			# sort by name
$timeout = 180;			# default timeout used in LWP code

my %options = ("file=s"    => \$file, 
	       "time=i"    => \$delay, 
	       "fwall:s"   => \$firewall, 
	       "proxy=s"   => \$proxy,
	       "wide"      => \$wide,
	       "chart=s"   => \$chart,
	       "sort=s"    => \$sort,
	       "nookbutton"=> \$nookbutton,
	       "timeout=i" => \$timeout,
	       "help"      => \$help);
# exit with helpful message if unknown command-line option, or help request
help_exit() if (!GetOptions(%options) or $help);

menus();			# create frame, and populate with menus

if ($#ARGV==-1) {		# if no argument given
  if (-f $file) {		#    if file exists
    file_open() ;		#       load from file
  } else {			#    else use default penguin portfolio
    warn("No arguments given, and no file found. Using example portfolio.\n");
    init_data(("COBT::20:USDCAD", "COR.TO::100", 
	       "LNUX::100:USDCAD", "RHAT::20:USDCAD"));
    buttons();			#    and initialise it
  }
} else {			# else 
  init_data(@ARGV);		#    use the given arguments
  file_save();			#    store the given selection
  buttons();			#    and initialise it
}

MainLoop;			# and launch event loop under X11

#----- Functions ------------------------------------------------------------

sub menus {			# create the menus
  my $MF = $Main->Frame(-relief => 'ridge'
		       )->pack(-side => 'top', -anchor => 'n', 
			       -expand => 1, -fill => 'x');
  my @M;
  $M[0] = $MF->Menubutton(-text => 'File', 
			  -underline => 0,
			  -tearoff => 0
			 )->pack(-side => 'left');
  $M[0]->AddItems(["command" => "Open",  
		   -underline => 0,
		   -command => \&file_open],
		  ["command" => "Save",  
		   -underline => 0,
		   -command => \&file_save],
		  ["command" => "Exit",  
		   -underline => 0,
		   -command => sub { exit }]);

  $M[1] = $MF->Menubutton(-text => 'Edit', 
			  -underline => 0,
			  -tearoff => 0
			 )->pack(-side => 'left');
  $M[1]->AddItems(["command" => "Add Stock(s)", 
		   -underline => 0,
		   -command => \&add_stock]);
  $M[1]->AddItems(["command" => "Delete Stock(s)", 
		   -underline => 0,
		   -command => \&del_stock]);
  $M[1]->AddItems(["command" => "Change Update Delay",
		   -underline => 0,
		   -command => \&chg_delay]);
  $M[1]->separator();
  $M[1]->checkbutton(-label => "Wide display",
		     -underline => 0,
		     -command => \&buttons,
		     -variable => \$wide);

  $M[2] = $MF->Menubutton(-text => 'Charts',
			  -underline => 0,
			  -tearoff => 0
			 )->pack(-side => 'left');
  my %radiobutton_text = ('i' => 'Intraday',
			  'w' => 'Weekly',
			  '3' => 'Three months',
			  '1' => 'One year',
			  '2' => 'Two year',
			  '5' => 'Five year');
  foreach (qw/i w 3 1 2 5/) {
    $M[2]->radiobutton(-label => $radiobutton_text{$ARG},
		       -variable => \$chart,
		       -value => $ARG);
  }

  $M[3] = $MF->Menubutton(-text => 'Sort',
			  -underline => 0,
			  -tearoff => 0
			 )->pack(-side => 'left');
  my %sortbutton_text = ('n' => 'Name',
			 'r' => 'Relative Change',
			 'a' => 'Absolute Change',
			 'p' => 'Position Change',
			 'v' => 'Position Value');
  foreach (qw/n r a p v/) {
    $M[3]->radiobutton(-label => $sortbutton_text{$ARG},
		       -command => \&buttons,
		       -variable => \$sort,
		       -value => $ARG);
  }




  $M[4] = $MF->Menubutton(-text => "Update",
			  -underline => 0,
			 )->pack(-side => 'left');
  $M[4]->bind("<Button>", \&update_display_variables);


  $M[5] = $MF->Menubutton(-text => 'Help', 
			  -underline => 0,
			  -tearoff => 0
			 )->pack(-side => 'right');
  $M[5]->AddItems(["command" => "Manual", 
		   -underline => 0,
		   -command => \&help_about]);
  $M[5]->AddItems(["command" => "License", 
		   -underline => 0,
		   -command => \&help_license]);
}

sub buttons {			# create all display buttons

  # are we dealing with firewalls, and do we need to get the info ?
  if (defined($firewall) and ($firewall eq "" or $firewall !~ m/.*:.*/)) {
    get_firewall_id();		# need to get firewall account + password
    return;
  } 
    
  undef $Dat{'EU'};		# clear list of Yahoo UK! stocks
  undef $Dat{'NA'};		# clear list of Yahoo! stocks
  @{$Dat{'Arg'}} = sort @{$Dat{'Arg'}};
  foreach (@{$Dat{'Arg'}}) {	# if there is a suffix, and it's not Canada
    if (non_northamerican($ARG)) {
      push @{$Dat{'EU'}}, $ARG;	# then it must be Europe, or rest-of-the-world
    } else {
      push @{$Dat{'NA'}}, $ARG;	# else use the default: North America
    }
  }
  $BFrame->destroy() if Tk::Exists($BFrame);
  $BFrame = $Main->Frame(-relief => 'groove')->pack(-side=>'top',-fill=>'x');
  $BFrame->Label->repeat($delay*1000*60, \&update_display_variables);

  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,
				     -borderwidth => -5, 
				     -relief => 'flat',
				     -textvariable => \$Labels[$ARG]
				    )->pack(-side => 'top', -fill => 'x');
    $Buttons[$ARG]->bind("<Button-3>", [\&view_image, $ARG]);
  }
  update_display_variables();	# and populate those buttons
}

sub non_northamerican {		# test if stock is non-US/Canadian
  my $arg = shift;
  if ($arg =~ m/\.(\w+)$/ and ($1 !~ m/^(TO|V|M)$/)) {
    return 1;
  } else {
    return 0;
  }
}

sub sort_func {			# sort shares for display
  my @a = split /;/, $a;
  my @b = split /;/, $b;

  if ($sort eq 'r') {		# do we sort by returns (relative change)
    my ($achg) = $a[6] =~ /([\+\-\d\.]*)\%/;	# extract percent change 
    my ($bchg) = $b[6] =~ /([\+\-\d\.]*)\%/;	# extract percent change 
    return $bchg <=> $achg	# apply descending (!!) numerical comparison
      || $a[1] cmp $b[1]	# or default to textual sort on names
  } elsif ($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 ($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 ($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
  } else {			# alphabetical sort
    return $a[1] cmp $b[1]
  }

}

sub update_display_variables {  # gather data, and update display strings
  update_data();		# fetch the data from the public servers
  compute_max_position();	# update the size of the biggest position
  update_display();		# and update the ticker display
}

sub update_data {		# gather data from Yahoo! servers

  if ($#{@{$Dat{'FXarr'}}}>-1) {# if there are cross-currencies
    my $URL = "http://quote.yahoo.com/d?f=sl1&s=";
    my $array = getquote($URL,@{$Dat{'FXarr'}});	# get FX crosses
    foreach my $ra (@$array) {	
      $ra->[0] =~ s/\=X//;	# reduce back to pure cross symbol
      $Dat{'FX'}{uc $ra->[0]} = $ra->[1]; # 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,divyld, cap
  if ($#{@{$Dat{'NA'}}}>-1) {	# if there are stocks for Yahoo! North America
    my $URL = "http://quote.yahoo.com/d?f=snl1d1t1c1p2va2bapomwerr1dyj1x&s=";
    my $array = getquote($URL,@{$Dat{'NA'}});	# get North American quotes
    foreach my $ra (@$array) {
      push @{$Dat{'Data'}}, join(";", @$ra); # store all info
    } 
  }

  # Ugly, ugly: there are less data for 'EU' type stocks:
  # EU: symbol, price, lasttrade (d/m/y), change, low, high, prev, vol
  # so we have to splice it together with '-' to signal missing data
  if ($#{@{$Dat{'EU'}}}>-1) { 	# if there are stocks for Yahoo! UK
    my $URL = "http://finance.uk.yahoo.com/quote.csv?d=s&s=" ;
    my $array = getquote($URL,@{$Dat{'EU'}});# European quotes
    foreach my $ra (@$array) {
      my $name = $Dat{'GivenName'}{uc $ra->[0]} || $ra->[0];
      my $pc_chg = 0;
      $pc_chg = 100*$ra->[3]/$ra->[6] if $ra->[6] != 0;
      # pass array as ad-hoc string, mark missing values
      push @{$Dat{'Data'}}, join(";", (uc $ra->[0], $name, 
				       $ra->[1], $ra->[2], "-", 
				       $ra->[3],sprintf("%5.2f%%",$pc_chg), 
				       $ra->[7], "-", "-", "-", $ra->[6], "-",
				       "$ra->[4] - $ra->[5]", "-",
				       "-", "-", "-", "-", "-"));
    } 
  }
} 

sub compute_max_position {

  undef %{$Dat{'Price'}};
  undef %{$Dat{'Change'}};
  undef %{$Dat{'Bps'}};
  undef %{$Dat{'PLContr'}};
  undef %{$Dat{'Value'}};

  # 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
  for my $i (0..$#{@{$Dat{'Arg'}}}) {
    my @arr = split (';', @{$Dat{'Data'}}[$i]);
    my $symbol = uc $arr[0];
    $Dat{'Name'}{$symbol} = $arr[1];
    $Dat{'Price'}{$symbol} = $arr[2];
    $Dat{'Change'}{$symbol} = $arr[5];
    my ($pc) = $arr[6] =~ /([\+\-\d\.]*)\%/;	# extract percent change 
    $Dat{'Bps'}{$symbol} = 100*$pc;
    my $fx = $Dat{'FX'}{ $Dat{'Cross'}{$symbol} } || 1;
    my $plcontr = $Dat{'Shares'}{$symbol} * $Dat{'Change'}{$symbol} * $fx;
    $Dat{'PLContr'}{$symbol} = $plcontr;
    my $value = $Dat{'Shares'}{$symbol} * $Dat{'Price'}{$symbol} * $fx;
    $Dat{'Value'}{$symbol} = $value;
  }
}

sub update_display {
  my $pl = 0;			# profit/loss counter
  my $nw = 0;			# networth counter

  my $max_len = 0;
  foreach my $val (values %{$Dat{'Name'}}) {
    $max_len = length($val) if (length($val) > $max_len);
  }

  my $max_price = 0;
  foreach my $val (values %{$Dat{'Price'}}) {
    $max_price = $val if ($val > $max_price);
  }

  my $max_change = 1.00;	# 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);
  }

  # ceiling of number of digits in position
  my $r = $max_len;
  my $q = 3 + digits($max_price);  # dot and two digits
  my $x = 3 + max(digits($max_change), digits($min_change));
  my $y = max(digits($max_bps),digits($min_bps));
  my $p = max(digits($max_plc),digits($min_plc));
  my $z = digits($max_value);

  # sort data
  @{$Dat{'Data'}} = sort sort_func @{$Dat{'Data'}};

  # Now apply all that information to the display
  for my $i (0..$#{@{$Dat{'Arg'}}}) {
    my @arr = split (';', @{$Dat{'Data'}}[$i]);
    my $symbol = uc $arr[0];
    my $name = $arr[1];

    if ($Dat{'Change'}{$symbol} < 0) { # if we're loosing money on this one
      $Buttons[$i]->configure(-foreground => 'red', 
			      -activeforeground => 'red');
    } else {
      $Buttons[$i]->configure(-foreground => 'black');
    }

    $Labels[$i] = sprintf("%*s %$q.2f %$x.2f %$y.0f bps", 
			  -$r, 
			  $name, 
			  $Dat{'Price'}{$symbol},
			  $Dat{'Change'}{$symbol},
			  $Dat{'Bps'}{$symbol});

    if ($wide) {		
      $Labels[$i] = $Labels[$i] . sprintf(" %$p.0f %$z.0f", 
					  $Dat{'PLContr'}{$symbol}, 
					  $Dat{'Value'}{$symbol});
    }

    $nw = $nw + $Dat{'Value'}{$symbol};
    $pl = $pl + $Dat{'PLContr'}{$symbol};
  }

  my $bps = $nw - $pl != 0 ? 100*100*($pl/($nw-$pl)) : 0; 
  my $txt = sprintf("%.0f bps at %s", $bps,
		    POSIX::strftime("%H:%M", localtime));
  $txt = $txt . sprintf(" p/l %.0f net %.0f", $pl, $nw) if ($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;

  # rounded(log10(0.5) gives 0 even though this has 1 leading decimal
  $x = $x * 10 if (abs($x) > 0 and abs($x) < 1); 
  $x = $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);# 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 ...
  my $Text = $TL->Text(-height => 23, 
		       -width => 39,
		       -font => $BFont,
		      )->pack();
  my @arr = split (';', @{$Dat{'Data'}}[$key]);
  $TL->title("Details for $arr[1]");
  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",
	      "Dividend Yield", "Market Capital");
  foreach (0..$#text) {
    $Text->insert('end',  sprintf("%-16s %s\n", $text[$ARG], $arr[$ARG]));
  }
  my $fx = $Dat{'FX'}{ $Dat{'Cross'}{$arr[0]} } || 1;
  my $shares = $Dat{'Shares'}{$arr[0]} || 0;
  $Text->insert('end',  sprintf("%-16s %s\n%-16s %.2f\n%-16s %.2f\n", 
				"Shares Held", $shares,
				"Value Change", $shares * $arr[5] * $fx,
				"Total Value", $shares * $arr[2] * $fx));
  button_or_mouseclick_close($TL,$Text);
}            

sub button_or_mouseclick_close {
  my ($A,$B) = @_;
  if ($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 view_image {
  my ($widget,$arg) = @_;
  my @arr = split (';', @{$Dat{'Data'}}[$arg]);

  return if non_northamerican($arr[0]);

  my $url = getchart(symbol => lc $arr[0], 
		       type => $chart, 
		       size => "b",     # default of large charts
		       include => "m");	# with moving averages
  my $ua = RequestAgent->new;	
  $ua->env_proxy;
  $ua->proxy('http', $proxy) if $proxy;
  $ua->timeout($timeout);		# time out after this many secs
  my $tmpnam = POSIX::tmpnam();  
  open FILE, "> $tmpnam";
  binmode FILE;;
  print FILE $ua->request(GET $url)->content or warn "Trouble!\n";
  close FILE;
  my $TL = $Main->Toplevel;	# new toplevel widget ...
  $TL->title ("Graph for $arr[1]");
  my $PH = $TL->Photo(-file => $tmpnam);
  my $LB = $TL->Label(-image => $PH)->pack();
  unlink($tmpnam);
  button_or_mouseclick_close($TL,$LB);
}

sub file_open {			# get the data from the resource file
  open (FILE, "<$file") or die "Cannot open $file: $!\n";
  while (<FILE>) {
    next if (m/(\#|%)/);	# ignore comments, if any
    next if (m/^\s*$/);		# ignore empty lines, if any
    chop;
    if (m/^\s*(\$\w+)=(\d+)\s*$/) {
      my $arg = $1;
      my $val = $2;
      if ($arg =~ m/\$retsort/){	# test for legacy option
	if ($val) {
	  $sort='r';		# old options $retsort was set to 1
	} else {
	  $sort='n';
	}
      } else {
	eval "$1=$2\n";		# store numerical option
      }
  
    } elsif (m/^\s*(\$\w+)=(\S+)\s*$/) {
      eval "$1=\"$2\"\n";	# store text option
    } else {
      insert_stock($ARG);
    }
  }
  close(FILE);
  init_fx();
}

sub insert_stock {		# insert one stock into main data structure
  my $arg = shift;
  my @arr = split ':', $arg;	# split along ':'
  $arr[0] = uc $arr[0];		# uppercase the symbol
  push @{$Dat{'Arg'}}, $arr[0];	# store symbol 
  $Dat{'GivenName'}{$arr[0]} = defined($arr[1]) ? $arr[1] : "";
  $Dat{'Shares'}{$arr[0]} = defined($arr[2]) ? $arr[2] : 0;
  $Dat{'Cross'}{$arr[0]} = defined($arr[3]) ? $arr[3] : "";
}

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
    }
  }
  buttons();
}

sub init_data {			# fill all arguments into main data structure
  my @args = @_;
  undef $Dat{'Arg'};
  foreach $ARG (@args) {
    insert_stock($ARG);
  }
  init_fx();
}

sub file_save {			# store in resource 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 $ARG (qw($file $delay $help $proxy $wide $chart $sort 
		   $nookbutton $timeout)) {
    print FILE "$ARG=", eval("$ARG"),"\n" if eval("defined($ARG)");
  }
  foreach (0..$#{$Dat{'Arg'}}) {
    my $sym = @{$Dat{'Arg'}}[$ARG];
    print FILE join(':', (uc $sym, $Dat{'GivenName'}{$sym}, 
			  $Dat{'Shares'}{$sym}, $Dat{'Cross'}{$sym})), "\n"; 
  }
  close(FILE);
}

sub add_stock {			# window to add one or several stocks
  my $TL = $Main->Toplevel;	# new toplevel widget ...
  my $ARG = "";
  $TL->title ("Add Stock(s))");
  $TL->Entry(-textvariable => \$ARG, -width => 78
	    )->pack(-expand => 1, -fill => 'x');
  my $Text = $TL->Text(-width => 78, -height => 12, -relief => 'flat')->pack();
  $Text->insert('end', 
qq{Add one or several stock(s), separated by semicolons. For each stock, up to
four input fields that are separated by colons are recognised, but only the 
first, the symbol, is required. Following the symbol a full name can be
specified to make up for the lack of a name returned from Yahoo! UK. The 
third argument is the number of shares used to aggregate gains or losses. 
The last argument is the crosscurrency pair, in ISO notation, to transform 
the price into the domestic currency.
A complete example for a hypothetical Canadian investor with telecom shares 
in three different countries: 
    BT.A.L:BRITISH TELECOM:10:GBPCAD;BCE.TO::10;T::10:USDCAD 
Here a name is supplied for the first stock, cross-currencies for the first 
and third, and holdings for all three. });

  $TL->Button(-text => 'Add',
	      -command => sub { my @arr = split ';', $ARG; 
				foreach my $ARG (@arr) {
				  insert_stock($ARG);
				}
				init_fx();
				$TL->destroy();
			      } 
	     )->pack(-side => 'bottom');
}

sub del_stock {			# delete one or several stocks
  my $TL = $Main->Toplevel;	# new toplevel widget ...
  $TL->title ("Delete Stock(s)");
  my $symb = "";
  my $LB = $TL->Scrolled("Listbox", 
			 -selectmode => "multiple",
			 -scrollbars => "e",
			 -width => 25
			)->pack();
  $LB->insert('end', @{$Dat{'Arg'}});
  $TL->Label(-text => 'Select stocks to be deleted')->pack();
  $TL->Button(-text => 'Delete',
	      -command => sub { 
		my @A;		# temp. array 
		foreach (0..$#{$Dat{'Arg'}}) {
		  push @A, $Dat{'Arg'}[$ARG] 
		    unless $LB->selectionIncludes($ARG);
		}
		@{$Dat{'Arg'}} = @A;
		buttons();
		$TL->destroy();	# this can lead to a segmentation fault
	      }
 	     )->pack(-side => 'bottom');
}

sub chg_delay {			# window to modify delay for update
  my $TL = $Main->Toplevel;	# new toplevel widget ...
  $TL->title ("Modify Delay");
  my $SC = $TL->Scale(-from => 1,
		      -to => 30,
		      -orient => 'horizontal',
		      -sliderlength => 15,
		      -variable => \$delay)->pack();
  $TL->Label(-text => 'Change the update delay in minutes')->pack();
  $TL->Button(-text => 'Ok',
	      -command => sub { buttons(); 
				$TL->destroy();
			      }     )->pack(-side => 'bottom');
}

sub help_about {		# show a help window
  my $TL = $Main->Toplevel;	# uses pod2text on this very file :->
  $TL->title("Help about smtm");
  my $Text = $TL->Scrolled("Text", 
			   -width => 80, 
			   -scrollbars => 'e')->pack();
  button_or_mouseclick_close($TL,$Text);
  open (FILE, "pod2text $PROGRAM_NAME | ");
  while (<FILE>) {
    $Text->insert('end', $ARG);	# insert what pod2text show when applied
  }				# to this file, the pod stuff is below
  close(FILE);
}

sub help_license {		# show a license window
  my $TL = $Main->Toplevel;	# uses pod2text on this very file :->
  $TL->title("Copying smtm");
  my $Text = $TL->Text(-width => 77, 
		       -height => 21)->pack();
  button_or_mouseclick_close($TL,$Text);
  open (FILE, "< $PROGRAM_NAME");
  while (<FILE>) {		# show header
    last if m/^$/;
    next unless (m/^\#/ and not m/^\#\!/);
    $ARG =~ s/^\#//;		# minus the leading '#'
    $Text->insert('end', $ARG);
  }
  $Text->insert('end', "\n   smtm version $version as of $date");
  close(FILE);
}

sub get_firewall_id {
  my ($user,$passwd);
  my $TL = $Main->Toplevel;	# new toplevel widget ...
  $TL->title ("Specify Firewall ID");
  my $F1 = $TL->Frame;
  $F1->pack(-side => 'top');
  $F1->Label(-text => 'Firewall Account')->pack(-side => 'left');
  $F1->Entry(-textvariable => \$user,      
	     -width => 20)->pack(-side => 'right');
  my $F2 = $TL->Frame;
  $F2->pack();
  $F2->Label(-text => 'Firewall Passwd ')->pack(-side => 'left');
  $F2->Entry(-textvariable => \$passwd, 
	     -show => '*', 
	     -width => 20)->pack(-side => 'right');
  $TL->Button(-text => 'Ok',
	      -command => sub { $firewall = "$user:$passwd";
				$TL->destroy();
			      } 
	     )->pack(-side => 'bottom');
}

sub help_exit {			# command-line help
  print STDERR "

smtm -- Display and update a global stock ticker and profit/loss counter

smtm version $version of $date, Copyright (C) 1999 by Dirk Eddelbuettel 
smtm comes with ABSOLUTELY NO WARRANTY. This is free software, 
and you are welcome to redistribute it under certain conditions. 
For details, select Help->License or type Alt-h l once smtm runs.

Usage:   
   smtm [options] [symbol1 symbol2 symbol3 ....]

Options: 
   --time minutes    minutes to wait before update of display
                     (default value: $delay)
   --file rcfile     file to store and/or retrieve selected shares
                     (default value: $file)
   --proxy proxyadr  network address and port of firewall proxy 
                     (default value: none, i.e. no proxy) 
   --fwall [id:pw]   account and password for firewall, if the --fwall option
                     is used but not firewall id or passwd are give, a window
                     will prompt for them
                     (default value: none, i.e. no firewall)
   --chart len       select length of data interval shown in chart, choose one
                     of 'i' (intra-day), 'w' (1 week), '3' (3 months), 
                     '1' (1 year) or '5' (5 year)
                     (defauls value: $chart)
   --timeout len     timeout value in seconds for libwww-perl UserAgent
                     (defauls value: $timeout)
   --wide	     also display total value changes and holdings value
   --sort style      sort display of shares by specified style, choose
                     'r' for relative change, 'a' for absolute change
                     'p' for position change, 'v' for position value or
                     'n' for name.
                     (default value: $sort)
   --nookbutton      close other windows via left mouseclick, suppress button
   --help            print this help and version message

Examples:
   smtm T::10:USDCAD BCE.TO::10 
   smtm --time 15 \"BT.A.L:BR TELECOM:10:GBPCAD\"
   smtm --file ~/.telcos
   smtm --proxy http://192.168.100.100:80 --fwall foobar:secret

\n";
  exit 0;
}

sub getquote {			# taken from Dj's Finance::YahooQuote
  my ($URL,@symbols) = @_;	# and modified to allow for different URL
  my($x,@q,@qr,$ua,$url);	# and the simple filtering below as well
  $x = $";			# the firewall code below
  $" = "+";
  $url = $URL."@symbols";
  $" = $x;
  $ua = RequestAgent->new;
  # Load proxy settings from *_proxy environment variables.
  $ua->env_proxy;
  # or use the proxy specified as an option
  $ua->proxy('http', $proxy) if $proxy;
  $ua->timeout($timeout);	# timeout after this many secs
  foreach (split('\n',$ua->request(GET $url)->content)) {
    next if m/^\"SYMBOL\",\"PRICE\"/; # Yahoo! UK sends headers
    next if m/index.html/;	# try csv mode at Yahoo! UK to see this bug
    @q = grep { s/^"?(.*?)\s*"?\s*$/$1/; } split(',');
    push(@qr,[@q]);
  }
  return \@qr;
}				

BEGIN {				# Local variant of LWP::UserAgent that 
  use LWP;			# checks for user/password if document 
  package RequestAgent;		# this code taken from lwp-request, see
  no strict 'vars';		# the various LWP manual pages
  @ISA = qw(LWP::UserAgent);

  sub new { 
    my $self = LWP::UserAgent::new(@_);
    $self->agent("smtm/1.2.3");
    $self;
  }

  sub get_basic_credentials {
    my $self = @_;
    if (defined($main::firewall) and $main::firewall ne "" 
	and $main::firewall =~ m/.*:.*/) {
      return split(':', $main::firewall, 2);
    } else {
      return (undef, undef)
    }
  }
}

sub getchart {			# taken (almost) verbatim from Dj's YahooChart
  my %param = @_;		# and shortened as we need less arg. checking
  my $retval;			

  # Intraday - b = intraday/big; t = intraday/small;
  #	     w = week/big; v = week/small
  # ex: $ICURL/b?s=aapl
  my $ICURL = "http://ichart.yahoo.com/";

  # Normal charts - 0b = year/small; 3m = 3month/big; 1y = 1yr/big;
  #		  2y = 2yr/big; 5y = 5yr/big;
  #		  add s to chart against S&P500
  #		  add m to include moving average
  # ex: $CURL/0b/a/aapl.gif
  my $CURL = "http://chart.yahoo.com/c/";

  $retval = $ICURL.($param{'size'} eq "b" ? "b":"t").
    "?s=$param{'symbol'}" if $param{'type'} eq "i";
  $retval = $ICURL.($param{'size'} eq "b" ? "w":"v").
    "?s=$param{'symbol'}" if $param{'type'} eq "w";
  if ("1235" =~ $param{'type'}) {
    if ($param{'type'} eq "1") {
      $retval = $CURL.($param{'size'} eq "b" ? "1y":"0b");
    } else {
      $retval = $CURL.$param{'type'}.($param{'type'} eq "3" ? "m":"y");
    }
    $retval .= $param{'include'} if $param{'size'} eq "b";
    $retval .= "/".substr($param{'symbol'},0,1)."/".$param{'symbol'}.".gif";
  }
  return $retval;
}


__END__				# that's it, folks!  Documentation below

#---- Documentation ---------------------------------------------------------

=head1 NAME

smtm - Display and update a ticker of global stock quotes

=head1 SYNOPSYS

 smtm [options] [stock_symbol ...]

=head1 OPTIONS

 --time min	 minutes to wait before update 
 --file smtmrc   to store/retrieve stocks selected 
 --proxy pr      network address and port of firewall proxy 
 --fwall [id:pw] account and password for firewall 
 --chart len     select length of data interval shown in chart
                 (must be one of 1, w, 3, 1 or 5)
 --timeout len   timeout in seconds for libwww-perl UserAgent
 --wide		 also display value changes and holdings
 --sort style    sort display by specified style
                 (must be one r, a, p, v, or n)
 --nookbutton    close other windows via left mouseclick, suppress button
 --help          print a short help message


=head1 DESCRIPTION

B<smtm>, which is a not overly clever acronym for B<Show Me The
Money>, is a simple stock ticker application for quotes from exchanges
around the world (as long as they are carried on Yahoo!, that is). It
creates and automatically updates a window with stock quotes from
Yahoo!  Finance. When called with one or several stock symbols, it
displays these selected stocks, and also record the symbols for later
use.  When B<smtm> is called without arguments, it reads the symbols
tickers from a file. This file can be created explicitly by calling
the Save option from the File menu, or implicitly whenever B<smtm> is
called with one or more symbols. 

B<smtm> can also aggregate the change in value for both individual
positions and the the entire portfolio.  For this, the number of
shares is needed, as well as the cross-currency expression pair. The
standard ISO notation is used. As an example, GBPUSD translates from
Pounds into US Dollars.

B<smtm> display the full name of the company, the price change and the
percentage change. Losers are flagged in red.  B<smtm> can be used
for North American equities, as well as European ones. It should work
for other markets supported by Yahoo.  Due to the limited amount of
information provided by Yahoo! for the non-North American quotes, only
the symbol (but not the company name) is shown.  However, a name can also
be given by the user (see below). The sorting order can be chosen among
five different options.

The quotes are delayed, typically 15 minutes for NASDAQ and 20 minutes
otherwise, see F<http://finance.yahoo.com> for details.

B<smtm> supports both simple proxy firewalls (via the I<--proxy> option) 
and full-blown firewalls with account and password authorization (via the 
I<--fwall> option). Firewall account name and password can be specified as 
command line arguments after I<--fwall>, or else in a pop-up window. This 
setup has been in a few different environments. 

B<smtm> can display two more views of a share position. Clicking mouse
button 1 launches a detailed view with price, date, change, volume,
bid, ask, high, low, year range, price/earnings, dividend, dividend
yield and market capital information. However, not all of that
information is available at all North American exchange, and Yahoo! UK
only provides a subset.  Clicking the right mouse button display a
chart of the corresponding stock. The type of chart can be specified
either on the command-line, or via the Chart menu. Choices are
intraday, five day, three months, one year, two year or five year. The
default chart is a five day chart.

B<smtm> has been written and tested under Linux. It should run under
any standard Unix, success with Solaris and FreeBSD is confirmed (but
problems are reported under Solaris when a threaded version of Perl is
used). It also runs under that other OS from Seattle using the B<perl>
implementation from F<http://www.activestate.com>.  In either case, it
requires the F<Perl/Tk> module for windowing, and the F<LWP> module
(also known as F<libwww-perl>) for data retrieval over the web.

=head1 EXAMPLE

  smtm --file ~/.telcos "BT.A.L:BR TELECOM:10:GBPCAD" \
                         T::10:USDCAD \
                         BCE.TO::10 \
                        "13330.PA:FR TELECOM:10:EURCAD" \
                        "555700.F:DT TELECOM:10:EURCAD"

creates a window with prices for a handful of telecom companies on
stock exchanges in London, New York, Toronto, Paris and Frankfurt. The
selection will also be stored in a file F<~/.telcos>. Note how names
are specified for the European stocks (to overcome the fact that
Yahoo! UK does not return a name). Also determined are the number of
shares, here 10 for each of the companies. Lastly, this example
assumes a Canadian perspective: returns are converted from British
pounds, US dollars and Euros into Canadian dollars. Quotation marks
have to be used to prevent the shell from splitting the arguments
containing spaces.

=head1 MENUS

Six menus are supported: I<File>, I<Edit>, I<Charts>, I<Sort>,
I<Update> and I<Help>. The I<File> menu offers to load or save to the
default file, as well as the values of the currently chosen
options. The I<Edit> menu can launch windows to either add new stocks
(one or several if separated by semicolons) or delete them from a list
box (one or several at a time). It also allows to modify the delay
time between updates, to choose between the default share display or
the wide display with changes in the position and total position value
and to select a display sorted by percentage return instead of company
name.  The I<Charts> menu allows to select the default chart among the
choices intraday, five day, three months, one year, two year or five
year.  Similarly, the I<Sort> menu allows to select one of five different 
sort options. Selecting the I<Update> menu immediately updates the display.
Lastly, the I<Help> menu can display either the text from the manual
page, or the copyright information in a new window.

=head1 DISPLAY

The main window is very straightforward. For each of the stocks, four
items are displayed: its name, its most recent price, the change from
the previous close in absolute terms and in relative terms.  The
relative change is expressed in basispoints (bps), which are 1/100s of
a percent.  This display window is updated in regular intervals. If
the I<--wide> options is used, value changes and holdings value are
also displayed in the chosen cross-currency.

The window title displays the relative portfolio profit or loss for
the current day in basispoints (i.e., hundreds of a percent), as well
as the date of the most recent update. If the I<--wide> options is
used, the net change and ney value of the portfolio (both in local
currency) are also displayed.

Clicking on any of the stocks with the left mouse button opens a new
window with all available details for a stock. Unfortunately, the
amount of available information varies. Non-North American stocks only
have a limited subset of information made available via the csv
interface of Yahoo!. For North American stocks, not all fields all
provided by all exchanges. Clicking on the details display window
itself closes this window.

Clicking on any of the stocks with the right mouse button opens a new
window with a chart of the given stock in the default chart
format. This option is only available for North American stocks.
Clicking on the chart window itself closes this window.

=head1 BUGS

B<smtm> does not recover from bad selection in charts. If, say, a
five-year chart is requested for a company with only a two-year 
history, the program currently hangs.

Closing the stock addition or deletion windows have been reported to
cause random segmentation violation under Linux. This appears to be a 
bug in Perl/Tk which will hopefully be solved, or circumvented, soon. 
This bug does not bite under Solaris, FreeBSD or NT.

Problems with undefined symbols have been reported under Solaris 2.6 
when Perl has been compiled with thread support. Using an unthreaded 
Perl binary under Solaris works. How this problem can be circumvented is
presently unclear.

=head1 SEE ALSO

F<Finance::YahooQuote.3pm>, F<Finance::YahooChart.3pm>, F<LWP.3pm>,
F<lwpcook.1>, F<Tk::UserGuide.3pm>

=head1 COPYRIGHT

smtm is (c) 1999, 2000 by Dirk Eddelbuettel <edd@debian.org>

Updates to this program might appear at 
F<http://rosebud.sps.queensu.ca/~edd/code/smtm.html>.

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.  There is NO warranty whatsoever.

The information that you obtain with this program may be copyrighted
by Yahoo! Inc., and is governed by their usage license.  See
F<http://www.yahoo.com/docs/info/gen_disclaimer.html> for more
information.

=head1 ACKNOWLEDGEMENTS

The Finance::YahooQuote module by Dj Padzensky (on the web at
F<http://www.padz.net/~djpadz/YahooQuote/>) served as the backbone for
data retrieval, and a guideline for the extension to the non-North
American quotes. The Finance::YahooChart module by Dj Padzensky (on
the web at F<http://www.padz.net/~djpadz/YahooChart/>) provided the
routine for determining the Yahoo! Chart url. 

=cut

