quote/ 40755 2126 144 0 7152070722 11034 5ustar sergeyusersquote/ParseYahoo.pm100644 2126 144 10631 7152070722 13562 0ustar sergeyusers# # This module is a parser for the Yahoo's quote pages. # It's written for the quote.pl program. # # I've wrote it very quickly, so sorry for the lack of comments, # besides it's a very simple piece of code :-) # # Copyright (c) 2000 Sergey Gribov # This is free software with ABSOLUTELY NO WARRANTY. # You can redistribute and modify it freely, but please leave # this message attached to this file. # # Subject to terms of GNU General Public License (www.gnu.org) # package ParseYahoo; use HTML::Parser; use strict; my %quotes = (); my $stage = 0; my $cur_symbol = ""; # Create object sub new { my $proto = shift; my $class = ref($proto) || $proto; my $self = {}; bless($self, $class); foreach (@_) { $quotes{uc($_)} = {}; } return $self; } sub get_quotes_ptr { return \%quotes; } sub start { my($self, $tag, $attr, $attrseq, $origtext) = @_; # print "== $tag($stage): $origtext\n"; if ($tag eq "b" && (!$stage)) { $stage = "wt_symb"; } elsif ($tag eq "b" && $stage eq "price_td") { $stage = "wt_price"; } elsif ($tag eq "td" && $stage eq "symb") { $stage = "wt_price_td"; } elsif ($tag eq "td" && $stage eq "price") { $stage = "wt_change"; } elsif ($tag eq "td" && $stage eq "change") { $stage = "wt_close"; } elsif ($tag eq "td" && $stage eq "close") { $stage = "wt_volume"; } elsif ($tag eq "td" && $stage eq "volume") { $stage = "wt_range"; } elsif ($tag eq "td" && $stage eq "range") { $stage = "wt_bid"; } elsif ($tag eq "td" && $stage eq "bid") { $stage = "wt_ask"; } elsif ($tag eq "td" && $stage eq "ask") { $stage = "wt_open"; } elsif ($tag eq "td" && $stage eq "open") { $stage = "wt_52_range"; } elsif ($tag eq "td" && $stage eq "52_range") { $stage = "wt_pe"; } elsif ($tag eq "td" && $stage eq "pe") { $stage = "wt_mcap"; } } sub end { my($self, $tag, $origtext) = @_; # print "end $tag: $origtext\n"; $stage = 0 if ($tag eq "table"); } sub text { my($self, $origtext, $is_cdata) = @_; # print "++ text($stage): $origtext\n"; return unless $stage; if ($stage eq "wt_symb") { if ($origtext =~ /\:(\S+)\)\s+-\s+More\s+Info\:/is) { if (defined($quotes{uc($1)})) { $cur_symbol = uc($1); $stage = "symb"; # print "++ symbol: $cur_symbol ++++++++\n"; } } } elsif ($stage eq "wt_price_td") { if ($origtext =~ /Last\s+Trade/) { $stage = "price_td"; } } elsif ($stage eq "wt_price") { if ($origtext =~ /([0-9\.\/ ]+)/) { $stage = "price"; $quotes{$cur_symbol}{price} = $1; # print "++ text(): price=$quotes{$cur_symbol}{price} =\n"; } } elsif ($stage eq "wt_change") { if ($origtext =~ /Change\s*([0-9\.\/+\- ]+)\s*\(([0-9\.\/+\- \%]+)\)/i) { $stage = "change"; $quotes{$cur_symbol}{change} = $1; $quotes{$cur_symbol}{change_pct} = $2; # print "++ text(): change=$quotes{$cur_symbol}{change}\n"; # print "++ text(): change_pct=$quotes{$cur_symbol}{change_pct}\n"; } } elsif ($stage eq "wt_close") { if ($origtext =~ /Prev\s+Cls\s*([0-9\.\/ ]+)/i) { $stage = "close"; $quotes{$cur_symbol}{prv_close} = $1; } } elsif ($stage eq "wt_volume") { if ($origtext =~ /Volume\s*([0-9\.,]+)/i) { $stage = "volume"; $quotes{$cur_symbol}{volume} = $1; } } elsif ($stage eq "wt_range") { if ($origtext =~ /Day\'s\s+Range\s*([0-9\.\/ -]+)/i) { $stage = "range"; $quotes{$cur_symbol}{range} = $1; } } elsif ($stage eq "wt_bid") { if ($origtext =~ /Bid\s*([0-9\.\/ ]+)/i) { $stage = "bid"; $quotes{$cur_symbol}{bid} = $1; } } elsif ($stage eq "wt_ask") { if ($origtext =~ /Ask\s*([0-9\.\/ ]+)/i) { $stage = "ask"; $quotes{$cur_symbol}{ask} = $1; } } elsif ($stage eq "wt_open") { if ($origtext =~ /Open\s*([0-9\.\/ ]+)/i) { $stage = "open"; $quotes{$cur_symbol}{open} = $1; } } elsif ($stage eq "wt_52_range") { if ($origtext =~ /52-week\s+Range\s*([0-9\.\/ -]+)/i) { $stage = "52_range"; $quotes{$cur_symbol}{'52_range'} = $1; } } elsif ($stage eq "wt_pe") { if ($origtext =~ /P\/E\s*([0-9\.\/\- NA]+)/i) { $stage = "pe"; $quotes{$cur_symbol}{pe} = $1; } } elsif ($stage eq "wt_mcap") { if ($origtext =~ /Mkt\s+Cap\s*([0-9\.\/ BMbm]+)/i) { $stage = "mcap"; $quotes{$cur_symbol}{market_cap} = $1; } } } 1; quote/quote.pl100755 2126 144 40157 7152070722 12655 0ustar sergeyusers#!/usr/local/bin/perl #-d:ptkdb # # This is small Perl program which is going to quote.yahoo.com # and brings the stock quotes. # It's very usefull to be run inside fvwm's GoodStuff bar. # # This program uses ~/.quoterc file to initilize itself. # File is reloaded on 'HUP' sygnal. # The simple format of the file is: # stock_list=^IXIC,ORCL,SUNW # timeout=600 # rows_num=5 # # I've wrote it very quickly, so sorry for the lack of comments, # besides it's a very simple piece of code :-) # # Copyright (c) 2000 Sergey Gribov # This is free software with ABSOLUTELY NO WARRANTY. # You can redistribute and modify it freely, but please leave # this message attached to this file. # # Subject to terms of GNU General Public License (www.gnu.org) # my $BASEDIR; # This stuff is to find our actual location... BEGIN { use File::Basename; use Cwd; my $full = $0; my $cwd = Cwd::cwd(); while (-l $full) { $BASEDIR = dirname($full); $full = readlink $full; ($full !~ m|^/|) and $full = $BASEDIR . "/" . $full; } $BASEDIR = dirname($full); $BASEDIR = "$cwd" if (!$BASEDIR || $BASEDIR eq "./" || $BASEDIR eq "."); $BASEDIR = "$cwd/$BASEDIR" unless ($BASEDIR =~ m|^/|); unshift(@INC,$BASEDIR); } use Tk; use HTTP::Request::Common qw(POST); use LWP::UserAgent; use POSIX; use strict; my $parser_name = "ParseYahoo"; eval "use $parser_name;"; die "Eval failed: $@" if $@; my $verbose = 0; $verbose = 1 if ($ARGV[0] =~ /-v/); my $base_url = "http://quote.yahoo.com/quotes?detailed=t&symbols="; my @symbols = (); my $update_timeout = 600; my $norm_font = '-adobe-courier-bold-r-normal--10-100-75-75-m-60-iso8859-1'; my $big_font = '-adobe-courier-bold-r-normal--12-120-75-75-m-70-iso8859-1'; my $rows_num = 5; my $cur_row = 0; my $last_update = ""; my %basic = (); # basic (main) window data my @bas_labels = ('price', 'change_pct'); my %detailed = (); # detailed view data my @det_labels = ('price', 'change', 'change_pct', 'prv_close', 'volume', 'pe', 'market_cap'); my %pos = (); # stock positions my %positions = (); # positions view data my @pos_labels = ('price', 'total', 'num', 'bought', 'orig_cost'); print "Creating a main window...\n" if $verbose; $basic{main} = MainWindow->new; #$basic{main}->geometry("150x100+0-0"); $basic{main}->geometry("+0-0"); print "Reading ~/.quoterc file...\n" if $verbose; read_rcfile(); print "Creating the labels...\n" if $verbose; my $i = 0; for ($i=0; $i<(scalar(@bas_labels)+2); $i++) { $basic{frame}[$i] = $basic{main}->Frame()->pack(-fill=>'y', -side=>'left'); } $basic{frame}[scalar(@bas_labels)+1]->Button(-text=>"M \ne \nn \nu \n", -borderwidth=>1, -highlightthickness=>0, -padx=>0, -pady=>0, -relief=>'groove', -anchor=>'w', -font => $norm_font, -command=> \&show_params, )->pack(-fill=>'y', -expand=>1); create_labels(); print "Obtaining the quotes...\n" if $verbose; my $error = ""; my $q = check_quotes(); print "Updating the window...\n" if $verbose; update_win($q); $SIG{ALRM} = 'alarm_handler'; alarm($update_timeout); $SIG{HUP} = 'hup_handler'; print "Ready.\n" if $verbose; MainLoop; exit; ########################################################################## sub show_params { my $popup = $basic{main}->Toplevel; $popup->title("Quote parameters"); my $upd_lab = $popup->Label(-text => "Last time updated at\n$last_update"); if ($error) { $upd_lab->configure(-text => "ERROR: $error\n Last update at $last_update", -foreground => 'red'); } $upd_lab->pack(-fill=>'x'); my $fr = $popup->Frame(); $fr->Label(-text=>"Update timeout (sec.):" )->pack(-side=>'left'); $fr->Entry(-width=>3, -textvariable=>\$update_timeout)->pack(-side=>'right'); $fr->pack(-fill => 'x'); $fr = $popup->Frame(); $fr->Label(-text=>"Number of rows to show:" )->pack(-side=>'left'); $fr->Entry(-width=>3, -textvariable=>\$rows_num)->pack(-side=>'right'); $fr->pack(-fill => 'x'); $fr = $popup->Frame(); my $sym = ""; $fr->Entry(-width=>5, -textvariable=>\$sym)->pack(-side=>'right'); $fr->Button(-text => "Add quote for:", -borderwidth=>1, -relief=>'groove', -command => sub { if ($sym) { push(@symbols, uc($sym)); update(); $upd_lab->configure(-text => "Last time updated at\n$last_update"); } } )->pack(-fill => 'x'); $fr->pack(-fill => 'x'); $popup->Button(-text => "Detailed view", -borderwidth=>1, -relief=>'groove', -command => \&create_detailed_view, )->pack(-fill => 'x'); if (%pos) { $popup->Button(-text => "Portfolio", -borderwidth=>1, -relief=>'groove', -command => \&create_positions_view, )->pack(-fill => 'x'); } $popup->Label(-text=>" ")->pack(-fill=>'x'); $fr = $popup->Frame(); $fr->Button(-text => 'Update', -command => sub{ update(); $upd_lab->configure(-text => "Last time updated at\n$last_update"); } )->pack(-side=>'left'); $fr->Button(-text => 'Close', -command => [$popup=>'destroy'] )->pack(-side=>'left'); $fr->Button(-text => 'Exit', -command => sub { exit; } )->pack(-side=>'left'); $fr->pack(-side=>'bottom'); } # Create positions view sub create_positions_view { my ($fr, $i, $sym); my $total = "--"; $positions{main}->destroy() if Exists($positions{main}); $positions{main} = $basic{main}->Toplevel; $positions{main}->title("Portfolio"); $positions{main}{upd_lab} = $positions{main}->Label( -font => $norm_font, -text => "Last time updated at $last_update"); $positions{main}{upd_lab}->pack(-fill=>'x'); $positions{main}{total} = $positions{main}->Label( -font => $big_font, -text => "Total: $total"); $positions{main}{total}->pack(-fill=>'x'); $fr = $positions{main}->Frame(); $fr->Button(-text => 'Update', -command => \&update, )->pack(-side=>'left'); $fr->Button(-text => 'Close', -font => $norm_font, -command => [$positions{main} => 'destroy'] )->pack(-side=>'left'); $fr->Button(-text => 'Exit', -font => $norm_font, -command => sub { exit; } )->pack(-side=>'left'); $fr->pack(-side=>'bottom'); create_row_frames(\%positions, \@pos_labels); # create frames # create row labels $positions{labels} = (); map (create_row_labels($_, \%positions, \@pos_labels), @symbols); update_positions_view(); } # update positions view sub update_positions_view { my ($sym, $fgcolor, $i, $total, $orig, $d); $total = 0; $orig = 0; return unless Exists($positions{main}); unless ($q) { $positions{main}{upd_lab}->configure(-text => "ERROR: $error\n Last update at $last_update", -foreground => 'red'); return; } foreach $sym (sort keys %pos) { $_ = $sym; $_ =~ s/\^//g; create_row_labels($sym, \%positions, \@pos_labels) unless Exists($positions{labels}{$sym}[0]); $positions{labels}{$sym}[0]->configure(-text => $_); $positions{labels}{$sym}[0]->pack(-fill=>'x'); $pos{$sym}{price} = $q->{$sym}{price}; $pos{$sym}{total} = get_num($q->{$sym}{price}) * $pos{$sym}{num}; $total += $pos{$sym}{total}; $orig += $pos{$sym}{orig_cost}; $pos{$sym}{total} = int($pos{$sym}{total} * 100) / 100; $d = $pos{$sym}{total} - $pos{$sym}{orig_cost}; $d = "+".$d if ($d > 0 && $pos{$sym}{orig_cost}); $fgcolor = get_row_color($d); for ($i=0; $iconfigure( -foreground=>$fgcolor, -text => $pos{$sym}{$pos_labels[$i]}); $positions{labels}{$sym}[$i+1]->pack(-fill=>'x'); } } $total = int($total * 100) / 100; $orig = int($orig * 100) / 100; $positions{main}{upd_lab}->configure(-text => "Last time updated at $last_update", -foreground => 'black'); $positions{main}{total}->configure(-text => "Total: $total Orig: $orig", -foreground => 'black'); } # Get number value from the price string sub get_num { $_ = shift; split; return (@_[0] + eval(@_[1])); } # Create detailed view sub create_detailed_view { my ($fr, $i, $sym); $detailed{main}->destroy() if Exists($detailed{main}); $detailed{main} = $basic{main}->Toplevel; $detailed{main}->title("Detailed view"); $detailed{main}{upd_lab} = $detailed{main}->Label( -font => $norm_font, -text => "Last time updated at $last_update"); $detailed{main}{upd_lab}->pack(-fill=>'x'); $fr = $detailed{main}->Frame(); $fr->Button(-text => 'Update', -command => \&update, )->pack(-side=>'left'); $fr->Button(-text => 'Close', -font => $norm_font, -command => [$detailed{main} => 'destroy'] )->pack(-side=>'left'); $fr->Button(-text => 'Exit', -font => $norm_font, -command => sub { exit; } )->pack(-side=>'left'); $fr->pack(-side=>'bottom'); create_row_frames(\%detailed, \@det_labels); # create frames # create row labels $detailed{labels} = (); map (create_row_labels($_, \%detailed, \@det_labels), @symbols); update_detailed_view(); } # Create row labels for the detailed/position table for symbol $sym sub create_row_labels { my ($sym, $win, $labels) = @_; for (my $i=0; $i<(scalar(@$labels)+1); $i++) { $win->{labels}{$sym}[$i] = $win->{frame}[$i]->Label(-borderwidth=>1, -relief=>'groove', -anchor=>'w', -font => $norm_font); } } # create frames sub create_row_frames { my ($win, $labels) = @_; for (my $i=0; $i<(scalar(@$labels)+1); $i++) { $win->{frame}[$i] = $win->{main}->Frame()->pack(-fill=>'y', -side=>'left'); if ($i) { $win->{frame}[$i]->Label(-text => $labels->[$i-1], -borderwidth=>1, -relief=>'groove', -anchor=>'w', -font => $norm_font)->pack(-fill=>'x'); } else { $win->{frame}[$i]->Label(-text => "Symb", -borderwidth=>1, -relief=>'groove', -anchor=>'w', -font => $norm_font)->pack(-fill=>'x'); } } } # update detailed view sub update_detailed_view { my ($sym, $fgcolor, $i); return unless Exists($detailed{main}); unless ($q) { $detailed{main}{upd_lab}->configure(-text => "ERROR: $error\n Last update at $last_update", -foreground => 'red'); return; } foreach $sym (@symbols) { $_ = $sym; $_ =~ s/\^//g; create_row_labels($sym, \%detailed, \@det_labels) unless Exists($detailed{labels}{$sym}[0]); $detailed{labels}{$sym}[0]->configure(-text => $_); $detailed{labels}{$sym}[0]->pack(-fill=>'x'); $fgcolor = get_row_color($q->{$sym}{change_pct}); for ($i=0; $iconfigure( -foreground=>$fgcolor, -text => $q->{$sym}{$det_labels[$i]}); $detailed{labels}{$sym}[$i+1]->pack(-fill=>'x'); } } $detailed{main}{upd_lab}->configure(-text => "Last time updated at $last_update", -foreground => 'black'); } # Read the ~/.quoterc file sub read_rcfile { my $fname = $ENV{'HOME'}."/.quoterc"; %pos = (); open(F, $fname) or die "Can't open file $fname: $!"; while() { next if (/^\s*$/); next if (/^#/); if (/stock_list\s*=\s*(.*)$/i) { $_ = $1; $_ =~ s/\s//g; @symbols = split /,/; } elsif (/detailed_labels\s*=\s*(.*)$/i) { $_ = $1; $_ =~ s/\s//g; @det_labels = split /,/; } elsif (/basic_labels\s*=\s*(.*)$/i) { $_ = $1; $_ =~ s/\s//g; @bas_labels = split /,/; } elsif (/timeout\s*=\s*(\d+)$/i) { $update_timeout = $1; } elsif (/rows_num\s*=\s*(\d+)$/i) { $rows_num = $1; } elsif (/pos\s*=\s*(.*)$/i) { $_ = $1; split; $pos{@_[0]}{num} += @_[1]; $pos{@_[0]}{bought} = @_[2]; $pos{@_[0]}{orig_cost} += @_[3]; } } close(F); } sub alarm_handler { $q = check_quotes(); update_win($q); update_detailed_view(); update_positions_view(); my $h = `/bin/date +%k`; chomp $h; my $timeout = 0; $timeout = (8 - $h)*3600 if ($h < 8); $timeout = (32 - $h)*3600 if ($h > 17); $timeout = $update_timeout unless $timeout; alarm($timeout); } sub hup_handler { alarm(0); read_rcfile(); update(); } sub update { alarm(0); create_labels(); $q = check_quotes(); update_win($q); update_detailed_view(); update_positions_view(); alarm($update_timeout); } sub create_labels { my ($sym, $i, $row); foreach $sym (keys %{ $basic{labels} }) { for ($i=0; $i<(scalar(@bas_labels)+1); $i++) { $basic{labels}{$sym}[$i]->destroy() if (Exists($basic{labels}{$sym}[$i])); } } $basic{labels} = (); my $n = ($cur_row + $rows_num) > scalar(@symbols) ? scalar(@symbols) : ($cur_row + $rows_num); for ($row=$cur_row; $row<$n; $row++) { $sym = $symbols[$row]; next unless $sym; for ($i=0; $i<(scalar(@bas_labels)+1); $i++) { $basic{labels}{$sym}[$i] = $basic{frame}[$i]->Label(-borderwidth=>1, -padx=>0, -pady=>1, -relief=>'groove', -anchor=>'w', -font => $norm_font); } } if (Exists($basic{labels}{$symbols[$cur_row]}[0])) { $basic{labels}{$symbols[$cur_row]}[0]->destroy(); $basic{labels}{$symbols[$cur_row]}[0] = $basic{frame}[0]->Button(-borderwidth=>1, -highlightthickness=>0, -padx=>0, -pady=>0, -relief=>'groove', -anchor=>'w', -font => $norm_font, -command => sub{ $cur_row-- if $cur_row; create_labels(); update_win($q); }); } if (Exists($basic{labels}{$symbols[$n - 1]}[0])) { $basic{labels}{$symbols[$n - 1]}[0]->destroy(); $basic{labels}{$symbols[$n - 1]}[0] = $basic{frame}[0]->Button(-borderwidth=>1, -highlightthickness=>0, -padx=>0, -pady=>0, -relief=>'groove', -anchor=>'w', -font => $norm_font, -command => sub{ $cur_row++ if (($cur_row + $rows_num) < scalar(@symbols)); create_labels(); update_win($q); }); } } sub update_win { my $quotes = shift; my $fgcolor = "black"; my ($row, $sym, $i); return unless $quotes; my $n = ($cur_row + $rows_num) > scalar(@symbols) ? scalar(@symbols) : ($cur_row + $rows_num); for ($row=$cur_row; $row<$n; $row++) { $sym = $symbols[$row]; next unless $sym; # foreach my $sym (@symbols) { $_ = $sym; $_ =~ s/\^//g; $basic{labels}{$sym}[0]->configure(-text => $_); $basic{labels}{$sym}[0]->pack(-fill=>'x'); $fgcolor = get_row_color($quotes->{$sym}{change_pct}); for ($i=0; $iconfigure(-foreground=>$fgcolor, -text => $quotes->{$sym}{$bas_labels[$i]}); $basic{labels}{$sym}[$i+1]->pack(-fill=>'x'); } } } # returns the color (red, green or black) depends if the stock is up or down sub get_row_color { my $change = shift; if ($change =~ /\+/) { return "#006600"; } elsif ($change =~ /-/) { return "red"; } return "black"; } sub check_quotes { print "Accesing $base_url... " if $verbose; my $ua = new LWP::UserAgent; $ua->agent('Mozilla/5.0'); my $url = $base_url.join(',',@symbols); my $req = new HTTP::Request 'GET', $url; my $ret = $ua->request($req); if ($ret->code != 200) { $error = "Can't access the server, code: ".$ret->code."\n Response:\n". $ret->as_string."\n"; return undef; } $error = ""; print "Done.\n" if $verbose; print "Parsing the results... " if $verbose; $last_update = strftime("%H:%M:%S %m/%d/%Y", localtime()); # print $ret->as_string; my $buf = $ret->as_string; #$buf =~ s/^.*Create\s+New\s+View//gis; #$buf =~ s/<\/table>\s*

\s*Quotes\s+delayed\s+.*$/<\/table>/gis; $buf =~ s/<\/?su[pb]>//gis; $buf =~ s/<\/?br>//gis; $buf =~ s/<\/?font[^>]*>//gis; #print $buf; my ($p, $parser); eval "\$parser = $parser_name->new(\@symbols);"; die "Eval failed: $@" if $@; eval "\$p = HTML::Parser->new(api_version => 3, start_h => [\\\&{$parser_name\:\:start}, \"self,tagname, attr, attrseq, text\"], end_h => [\\\&{$parser_name\:\:end}, \"self,tagname, attr, text\"], text_h => [\\\&{$parser_name\:\:text}, \"self,text\"], marked_sections => 1, unbroken_text => 1, );"; die "Eval failed: $@" if $@; $p->parse($buf); $p->eof; print "Done.\n" if $verbose; return $parser->get_quotes_ptr(); } # check_quotes