http://www.perlmonks.org?node_id=10011
Category: Win32/GUI
Author/Contact Info Joe Stewart a.k.a. httptech joe@NO.httptech.SPAM.com
Description: A Win32 GUI program to download Slashdot headlines every 30 minutes and display them in a small window.
#!c:\\perl\\bin\\perl.exe
# Slashdot Headline Grabber for Win32
# by Joe Stewart

use Win32::GUI;
use Win32::Shell;
use Socket;

my $count;
my %stories;
my @keys;

my $maxsize = ([400,42]);
my $minsize = ([200,42]);
my $main = Win32::GUI::Window->new(-name => 'Main',
-text => 'Slashdot Headlines',
-width => 275,
-height => 42,
-maxsize => $maxsize,
-minsize => $minsize);


my $label = new Win32::GUI::Label($main,
-text => "Downloading Headlines...",
-name => "Url", 
-width => 350,
-height => 42,
-left => 40,
-notify => 1);


my $button_back = new Win32::GUI::Button($main,
-text => "<",
-name => "Back",
-width => 15,
-left => 0,
-height => 15);

my $button_fwd = new Win32::GUI::Button($main,
-text => ">",
-name => "Fwd",
-width => 15,
-left => 15,
-height => 15);

$main->AddButton($button_back);
$main->AddButton($button_fwd);
$main->AddLabel($label);

my $Cycle = $main->AddTimer("Cycle", 10000);
my $Reload = $main->AddTimer("Reload", 1800000);

$main->Show();

GUI::Update($main);

my $inet = inet_aton('www.slashdot.org');
my $proto=getprotobyname('tcp');

&fetch_headlines;

$main->Url->Text($stories{$keys[0]});
$Cycle->Interval(10000);

Win32::GUI::Dialog();

sub Main_Terminate {
-1;
}

sub Fwd_Click {
$count++;
$count = 0 if $count == scalar(@keys);
$main->Url->Text($stories{$keys[$count]});
$Cycle->Interval(10000);
}

sub Back_Click {
$count--;
$count = scalar(@keys) - 1 if $count == -1;
$main->Url->Text($stories{$keys[$count]});
$Cycle->Interval(10000);
}


sub Url_DblClick {
my $url = $keys[$count];
Win32::Shell::Execute("open", $url, undef, undef, "SW_SHOWNORMAL");
return 1;
}

sub fetch_headlines {
my @D;
socket(S,PF_INET,SOCK_STREAM,$proto) || return 0;
if(connect(S,pack "SnA4x8",2,80,$inet)) {
select(S);      
$|=1;
print "GET /slashdot.xml HTTP/1.0\n\n";    
@D=<S>;
select(STDOUT); 
close(S);
} else { return 0 } 

my ($title, $url);

for (@D) {
$title = $1 if /\<title\>(.*)\<\/title\>/;
$url = $1 if /\<url\>(.*)\<\/url\>/;

if (/<\/story>/) { 
$stories{$url} = $title;
push(@keys, $url);
$title = "";
$url = "";
}
}
return 1;
}

sub Cycle_Timer {
&Fwd_Click;
return 1;
}

sub Reload_Timer {
&fetch_headlines;
$Reload->Interval(1800000);
return 1;
}