Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

Slashdot Headline Grabber for *nix

by czyrda (Initiate)
on Jul 11, 2000 at 03:02 UTC ( [id://21886]=sourcecode: print w/replies, xml ) Need Help??
Category: Web Stuff/GUI
Author/Contact Info icq#77263237
Description:

Gets the Slashdot headlines every 30 minutes.

#!/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}
}
Replies are listed 'Best First'.
RE: Slashdot Headline Grabber for *nix
by merlyn (Sage) on Jul 11, 2000 at 03:43 UTC
      indeed it's much simpler to grab the rss rdf file with LWP::Simple && parse with XML::RSS :)
      code example:
      #!/usr/bin/perl -w use strict; use XML::RSS; use LWP::Simple; my $news = ( 'slashdot' => ['Slashdot', 'http://slashdot.org/slashdot.rdf'] # add some more rss news sites .. ); foreach my $news ( keys %news) { $rsspage=get $news{$news}[1]; print "$news{$news}[0]:\n"; $rss = new XML::RSS; $rss->parse($rsspage); foreach my $item (@{$rss->{'items'}}) { print "\t$item->{'title'}\n"; print "\t$item->{'link'}\n\n"; } }
      just add the timer for your convinience :)
RE: Slashdot Headline Grabber for *nix
by httptech (Chaplain) on Jul 11, 2000 at 06:07 UTC
    You have to realize that my original code was not written for simplicity by using modules; it was designed to make the smallest possible .exe file when compiled. So I did away with LWP::Simple and used Socket because it saved 200K. I don't know how many extra kilobytes would have been used by the XML:RSS module, but I'm betting it's a lot more than are used by 3 or 4 lines worth of regexs.
      Who compiles to ".exe" files?

      If you want to share your cool new GUI Perl app with other Windoze users it doesn't seem likely that they will want to install Perl on their system just to run your app.

RE: Slashdot Headline Grabber for *nix
by cleen (Pilgrim) on Jul 11, 2000 at 03:12 UTC
    Very cool, and with the use of Socket; too!

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: sourcecode [id://21886]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others having a coffee break in the Monastery: (6)
As of 2024-03-19 11:30 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found