Phoenix.pm: Meeting 05/03/2001

[Mark Pease]

Doug Miles wrote:
> 
> Well, so far, it will be a short discussion.  I haven't received any
> from anyone.  So start sending away
> 

Well, I will not be able to make it (but, I teach the *last* perl class
for the semester tonight, so I may be able to make it some this summer!)
To help the discussion, here is a short (to maybe medium) script that I
use as an example.

I hope that it generates some discussion.
-- 
Mark Pease                                     Mark.Pease at motorola.com
Motorola DigitalDNA(tm) Laboratories             perl at perl.sps.mot.com
2200 W. Broadway Rd.   Phone:(480)655-6950        Mail Stop: AZ09 M350
Mesa, AZ 85202         Pager:(800)381-3304           FAX:(480)655-6192
   Co-Author (with Carl Dichter) of "Software Engineering with Perl"
-------------- next part --------------
#!/opt/perl5/bin/perl -w

use strict;
use Tk;
use Tk::Table;
use Tk::DialogBox;
use LWP::UserAgent;
use vars qw($mw);

# We make our own specialization of LWP::UserAgent that asks for
# user/password if document is protected or we are working through
# a firewall.
{
    package RequestAgent;
    use vars qw(@ISA);
    @ISA = qw(LWP::UserAgent);

    my %realm =();

    # Set up the RequestAgent to work through a firewall, if needed.
    sub new
    { 
	my $self = LWP::UserAgent::new(@_);
	# Make everyone think that we are using netscape!
	$self->agent("Mozilla/4.61");
	$self->env_proxy;
	$self;
    }

    # Pop up a TK dialog box to ask for the user name and password,
    # when we need to auth something.
    sub get_basic_credentials
    {
	my($self, $realm, $uri) = @_;
	if (defined $realm{$realm}) {
	    return (${$realm{$realm}}{user}, ${$realm{$realm}}{password});
	} else {
	    my $user;
	    my $password;
	    my $netloc = $uri->netloc;
	    my $db = $::mw->DialogBox(-title => "QuoteView Login",
				      -buttons => ["OK", "Cancel"]);

	    my $lab = $db->add('Label',
			    -text => "Enter username for $realm at $netloc: ")
			    ->pack(-side => 'top', -fill => 'x');

	    my $userfm = $db->add('Frame')->pack(
				-side => 'top',
				-fill => 'x');
	    my $userlabel = $userfm->Label(
			    -anchor => 'w',
			    -text => "Username:",
			    )->pack(-side => 'left');
	    my $userentry = $userfm->Entry(-textvariable => \$user,
					-relief => 'sunken')
					->pack(-side => 'right',
						-expand => 1,
						-fill => 'x',
						-anchor => 'w');

	    my $passwordfm = $db->add('Frame')->pack(
				-side => 'top',
				-fill => 'x');
	    my $passwordlabel = $passwordfm->Label(
				-anchor => 'w',
				-text => "Password:")->pack(-side => 'left');
	    my $passwordentry = $passwordfm->Entry(-textvariable => \$password,
					-show => '*',
					-relief => 'sunken')
					->pack(-side => 'right',
						-expand => 1,
						-fill => 'x',
						-anchor => 'w');
	    my $button = $db->Show;

	    if ($button eq "OK") {
		return (undef, undef) unless length $user;
		$realm{$realm} = { user => $user, password =>$password };
		return ($user, $password);
	    } else {
		return (undef, undef);
	    }
	}
    }
}

# Build up the main window to hold the quotes, etc.
$mw = MainWindow->new;
$mw->title("QuoteView");

# Build "info" label where message, etc will be displayed.
my $upLab = $mw->Label(-width => 40, -height => 1, -text => "Waiting...")->pack;

# The quotes are displayed in a table, so we build it.
my $table = $mw->Table(-rows => @ARGV + 1, -columns => 6, -scrollbars => '', -fixedrows => 1, -takefocus => 1)->pack;

# The first row of the table holds the headings.
for (1..6) {
    $table->put(0, $_, (qw(SYMBOL QUOTE TRADE CHANGE HIGH LOW))[$_-1]);
}

# Make a RequestAgent that will get the quotes.
my $ua = new RequestAgent || die "$!";

my $req = new HTTP::Request 'GET',"http://quote.yahoo.com/d/quotes.csv?s=" . join('+', @ARGV) . "&f=sl1d1t1c1ohgv&e=.csv"|| die "$!";

# Do it!
GetQuotes();
$mw->repeat(60000, sub {eval {GetQuotes()}; print $@ if $@;});
MainLoop;

# This routine makes the request, and parses the returned value.
sub GetQuotes {
    my $res = $ua->request($req) || die "$!";
    if ($res->is_success) {
	my $row = 1;
	foreach my $line (split /^/m, $res->content) {
	    chomp $line;
	    $line =~ /"(.+?)",(.*?),".*?","(.*?)",(.*?),.*?,(.*?),(.*?),/;
	    no strict 'refs';
		for (1..6) {
		    $table->put($row,$_,${$_});
		};
	    use strict 'refs';
	    $upLab->configure(-text => "" . localtime());
	    $row++;
	}
    } else {
	$upLab->configure(-text => "" . $res->status_line);
    }
}