Beefy Boxes and Bandwidth Generously Provided by pair Networks
Welcome to the Monastery
 
PerlMonks  

ztk-BBC-World-News-Rss-TickerTape

by zentara (Archbishop)
on Aug 07, 2005 at 18:05 UTC ( [id://481709]=sourcecode: print w/replies, xml ) Need Help??
Category: GUI Programming
Author/Contact Info zentara@zentara.net
Description: This grabs the rss for various BBC World News Service news feeds. It will launch the link associated with the scrolling text in mozilla, by left clicking the scrolling text with the mouse. A right-mouse-click will allow you to select a new channel. 
#!/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__

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?

www.com | www.net | www.org
Node Status?
node history
Node Type: sourcecode [id://481709]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? • Last hour • Other CB clients
Other Users?
Others browsing the Monastery: (2)
As of 2024-04-24 13:25 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found