#!/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}
}
[download]