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