#!/usr/bin/perl
use warnings;
use strict;
use threads;
use threads::shared;
use XML::RSS;
use Tk;
# by zentara@zentara.net August 7, 2005
# Please see BBC terms of use for their content at
# http://news.bbc.co.uk/1/hi/help/rss/4498287.stm
# Simple to use.
# At launch it will receive the "front_page" channel.
# Right-Mouse-Click will let you select another channel.
# Left-Mouse-Click will launch the link associated with
# the scrolling text item clicked. ( I have it set to launch
# mozilla, so you may need to adjust the launch command
# for your browser.
#####################################################################
# Declare variables
#http://newsrss.bbc.co.uk/rss/newsonline_world_edition/front_page/rss.
+xml
my $baseurl = 'http://news.bbc.co.uk/rss/newsonline_world_edition';
my @channels = qw(front_page africa americas asia-pacific business/e-c
+ommerce
business/economy business entertainment europe health/medical_notes
health middle_east science/nature south_asia talking_point technology
+in_depth
week_at-a-glance);
#make helper thread
my %thread;
share $thread{'go'};
share $thread{'die'};
share $thread{'get_channel'};
foreach my $ch(@channels){ share $thread{$ch} } #return xml
$thread{'go'} = 0;
$thread{'die'} = 0;
$thread{'url'} = '';
my $thread = threads->new( \&work ); #make thread
my $content;
my $file;
my %bbc;
my @queue=();
my @chans_sel=();
my %timer;
#set default channel
my $default_channel = 'front_page';
my $tl; #toplevel for selecting channels
# create new instance of XML::RSS
my $rss = new XML::RSS;
my $mw = MainWindow->new();
$mw->geometry('600x40+30+30');
#$mw->overrideredirect(1);
$mw->fontCreate('big',
-family=>'arial',
-weight=>'bold',
-size=>int(-18*18/14));
$mw->title("BBC World News -- Right Click Select Channel");
my $can = $mw->Canvas(
-background => 'black',
-relief => 'raised'
)->pack(-fill=>'both',-expand=> 1);
my $headertext = "............BBC World News (C)......Loading.........
+.";
my $ctexth = $can->createText(
50 ,20 ,
-text => "$headertext",
-anchor => 'w',
-fill => 'hotpink',
-font => 'big',
);
# a tandem pair of text widgets for continuous flow
my $ctext = $can->createText(
600 ,20 ,
-text => '',
-anchor => 'w',
-fill => 'hotpink',
-font => 'big',
);
my $ctext1 = $can->createText(
600 ,20 ,
-text => '',
-anchor => 'w',
-fill => 'hotpink',
-font => 'big',
);
my $ctexth_go = 0;
my $ctext_go = 0; #not moving yet
my $ctext1_go = 0; #not moving yet
my $mtimer1 = Tk::After->new($can, 10, 'repeat', \&move,-1 );
get_feed($default_channel);
$mw->bind('<ButtonPress-3>', \&select_chan);
$mw->protocol('WM_DELETE_WINDOW' => \&clean_exit);
$mw->bind('<ButtonPress-1>', \&launch_link);
setup_selector();
MainLoop;
###############################################################
sub clean_exit{
$thread{'die'} = 1;
$thread->join;
exit;
}
##########################################################
sub move {
my $dx = shift;
if( (defined $ctexth) && ($ctexth_go == 1 )){
$can->move($ctexth,$dx,0);
my ($x,$y,$x1,$y1) = $can->bbox($ctexth);
if( $x1 < 0){
$can->delete($ctexth);
undef $ctexth;
}
}
if( $ctext_go ){
$can->move($ctext,$dx,0);
my ($x,$y,$x1,$y1) = $can->bbox($ctext);
# print "$x1\n";
if( ($x1 < 580) && ($x1 > 0) && ($ctext1_go == 0) ){
#setup next text block
push (@queue,shift(@queue));
#shift @queue;
$can->itemconfigure($ctext1,-text=> $queue[0]);
$ctext1_go = 1;
}
if($x1 < 0){
#setup for next run in rotation
$ctext_go = 0;
$can->coords($ctext,600,20);
}
}
if( $ctext1_go ){
$can->move($ctext1,$dx,0);
my ($x,$y,$x1,$y1) = $can->bbox($ctext1);
if( ($x1 < 580) && ($x1 > 0) && ($ctext_go == 0) ){
#setup next text block
push (@queue,shift(@queue));
#shift @queue;
$can->itemconfigure($ctext,-text=> $queue[0]);
$ctext_go = 1;
}
if($x1 < 0){
#setup for next run in rotation
$ctext1_go = 0;
$can->coords($ctext1,600,20);
}
}
}
####################################################################
sub get_feed{
my $channel = shift;
$thread{'get_channel'} = $channel;
$thread{'go'} = 1;
$timer{$channel} = $mw->repeat(10,sub{
if( $thread{'go'} == 0 ){
$timer{$channel}->cancel;
&convert2hash($channel);
}
});
}
######################################################################
+###
sub convert2hash {
my ($channel) = @_;
if (! defined $thread{$channel} ){
&send_message( "$channel channel currently unavailable");
return;
}else{ $rss->parse( $thread{$channel} )}
# hashify the channel items
foreach my $item (@{$rss->{'items'}}) {
next unless defined($item->{'title'}) && defined($item->{'link'}
+);
$bbc{ $channel }{ $item->{'title'} }{'desc'} = $item->{'descri
+ption'};
$bbc{ $channel }{ $item->{'title'} }{'link'} = $item->{'link'}
+;
}
# my %chan_current = %{$bbc{$channel}};
# foreach my $key(keys %chan_current ){
# print "$key\n$chan_current{$key}{'desc'}\n$chan_current{$key}{'lin
+k'}\n\n";
# }
my %chan_current = %{$bbc{$channel}};
foreach my $key ( keys %chan_current){
if( defined $chan_current{$key}{'desc'} ){
push @queue, "...$key --> $chan_current{$key}{'desc'}.
+..BBC.$channel.||||||||";
}
}
#print "@queue\n\n\n\n";
#only run when nothing is scrolling
if(($ctext_go == 0)&&($ctext1_go == 0)){
#remove any loading message
$can->delete( $can->find( 'withtag', 'message' ) );
#start the display scrolling
$can->itemconfigure($ctext,-text=> $queue[0]);
$ctexth_go = 1; #move out the header
$ctext_go = 1;
}
}
######################################################################
+#####
sub setup_selector{
#setup channel selector
$tl = $mw->Toplevel(-bg=>'lightsteelblue');
$tl->overrideredirect(1);
$tl->withdraw;
$tl->title("Channels");
#Create the listbox and insert the list of choices in to it
my $lb = $tl->Scrolled("Listbox", -scrollbars => "osoe",
-height => 20,
-width => 35,
-selectmode => 'single',
-background => 'white',
-selectbackground => 'YELLOW',
-selectforeground => 'black',
)->pack();
foreach my $ch(@channels){
$lb->insert("end", $ch);
}
$tl->Button(-text => "Ok",
-command => sub {
my @chan = $lb->curselection();
foreach my $ch(@chan){
push @chans_sel,$lb->get($ch);
}
@queue = ();
$ctext_go = 0;
$ctext1_go = 0;
$can->itemconfigure($ctext,-text =>'',-tags=>[]);
$can->itemconfigure($ctext1,-text =>'',-tags=>[]);
$can->coords($ctext,600,20);
$can->coords($ctext1,600,20);
$can->createText(300,20,
-text=> 'Loading',
-fill=> 'green',
-font => 'big',
-tags=> ['message'],
);
$can->update;
foreach my $ch(@chans_sel){ get_feed($ch) }
$tl->withdraw;
})->pack;
}
######################################################################
+#####
sub select_chan{
CenterWindow($tl,225,400);
@chans_sel =();
$tl->deiconify;
$tl->raise;
}
######################################################################
+##
sub CenterWindow {
my($window, $width, $height) = @_;
$window->idletasks;
$width = $window->reqwidth unless $width;
$height = $window->reqheight unless $height;
my $x = int(($window->screenwidth / 2) - ($width / 2));
my $y = int(($window->screenheight / 2) - ($height / 2));
$window->geometry("=${width}x${height}+${x}+${y}");
}
######################################################################
+#####
sub send_message{
my $message = shift;
$mw->messageBox(
-background => 'lightyellow',
-icon => 'error',
-message => $message,
-type => 'OK'
);
}
######################################################################
+###
sub launch_link{
my $obj = $can->find('withtag','current');
my $textin = $can->itemcget( 'current', -text );
my ($key,undef,$channel) =
($textin) =~ /^\.\.\.(.*) --> (.*)\.\.\.\.BBC\.(.*)\.\|\|\|\|\|\|\|\|$
+/;
#print "$channel\n$key\n\n";
my $linkurl = $bbc{$channel}{$key}{'link'};
my $command = "mozilla -remote \"openURL($linkurl)\"";
if(fork() == 0){ exec ($command) }
}
######################################################################
+##
sub work{
use LWP::Simple;
$|++;
while(1){
if($thread{'die'} == 1){goto END }
if ( $thread{'go'} == 1 ){
my $channel = $thread{'get_channel'};
my $url = "$baseurl/$channel/rss.xml";
$thread{ $channel } = get( $url );
$thread{'go'} = 0; #turn off self before returning
}else
{ sleep 1 }
}
END:
}
##################################################
__END__
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.