#!/usr/bin/perl -w
use strict;
use Tk;
use Socket;
use IO::Handle;
use HTML::Entities; 
my (%stories, @bs, @binds, $mw, $value, $scale, 
    $scaled, $frame, $timer, $pid, $prog);
$prog = q(use Socket;
	  $inet = inet_aton "www.slashdot.org";
	  $proto = getprotobyname "tcp";
	  socket(S, PF_INET, SOCK_STREAM, $proto) || exit;
	  if(connect(S, pack "SnA4x8", 2, 80, $inet)) {
	      select S;
	      $| = 1;
	      print "GET /slashdot.rdf HTTP/1.0\n\n";
	      select STDOUT;
	      $| = 1;
	      while (<S>) {
		  $title = $1 if /\<title\>(.*)\<\/title\>/;
		  $url = $1 if /\<link\>(.*)\<\/link\>/;
		  if (/<\/item>/) {
		      print length($title),":",$title,$url,"\n";
		  }
	      }
	      close S;
	      close STDOUT;
	  });
@binds = ('<Enter>', '<Motion>', '<Leave>', '<1>', '<B1-Motion>', 
	  '<B1-Leave>', '<B1-Enter>', '<ButtonRelease-1>', '<2>',
	  '<B2-Motion>', '<B2-Leave>', '<B2-Enter>', '<ButtonRelease-2>');
$scaled = 1;
$mw = MainWindow->new;
$mw->resizable(0, 0);
$mw->configure(-title => 'Slashdot Headline Grabber');
$mw->repeat(1800000, \&Get);
$frame = $mw->Frame(-relief => 'ridge', -borderwidth => 2);
@bs = ($frame->Button(-text => 'Get',
		      -activebackground => '#43ce80',
		      -command => \&Get),
       $frame->Button(-text => 'Clear',
		      -activebackground => '#43ce80',
		      -command => \&Cancel), 
       $frame->Button(-text => 'Exit',
		      -activebackground => '#43ce80',
		      -command => \&Leave)
       );
$scale = $mw->
    Scale(-showvalue => 0,
	  -relief => 'flat',
	  -sliderrelief => 'flat',
	  -background => '#43ce80',
	  -borderwidth => 0,
	  -troughcolor => 'white',
	  -orient => 'horizontal',
	  );
map($mw->bind("Tk::Scale", $_, ""), @binds);
$frame->pack(-anchor => 'n', -expand => 1, -fill => 'x'); 
map($_->pack(-side => 'left', -expand => 1, -fill => 'x'), @bs);
$scale->pack(-anchor => 'nw', -expand => 0);
MainLoop;
sub Scale () {
    $_ = $scale->get();
    if ($_ <= 0) {$scaled= 1}
    if ($_ >= 100) {$scaled = -1}
    $scale->set($_ + $scaled);
}
sub Get () {
    &Cancel;
    $timer = $mw->repeat(9, \&Scale); 
    $pid = open (A, "perl -e '$prog'|");
    $mw->fileevent(\*A, 'readable', [\&Insertt]);
}
sub Cancel () {
    &Abort;
    &Clear;
}
sub Abort () {
    if ($pid) {
	kill 9, $pid;
	close A;
	$mw->fileevent(\*A, 'readable', '');
	$pid = 0;
	$timer->cancel();
	$scale->set(0);
	$timer = 0;
    }
}
sub Browser ($) {
    if (-l "$ENV{'HOME'}/.netscape/lock") {
	system(qq/netscape -remote 'openURL($_[0], new-window)' &/);
    } else {
	system(qq/netscape $_[0] &/);
    }
}
sub Clear () {
    map($_->[1]->destroy, values %stories);
    %stories = ();
}
sub Leave () {
    &Abort;
    exit;
}
sub Insertt () {
    my ($button, $title, $url);
    $_ = A->getline;
    if (defined $_) {
	chop;
	if(!/^(\d+):/ || 
	   !$1 ||
	   !/$1:(.{$1})(.+)/
	   ) {return}
	($title, $url) = ($1, $2);
	decode_entities($title);
	$button = $mw->Radiobutton(-anchor => 'w',
				   -indicator => 0,
				   -relief => 'groove',
				   -activebackground => '#43ce80',
				   -text => $title, 
				   -value => $title,
				   -variable => \$value,
				   -command => sub {		   
				       $stories{$value}[1] -> flash();
				       Browser($stories{$value}[0]);
				       $stories{$value}[1] -> deselect();
				   })
	    ->pack(-fill => 'both', -expand => 1);
	$stories{$title} = [$url, $button];
    } else {&Abort}
}