#!/usr/bin/perl # http://poe.perl.org/?POE_Cookbook/Tk_Interfaces # # This sample program creates a very simple Tk counter. Its interface # consists of three widgets: A rapidly increasing counter, and a # button to reset that counter. use warnings; use strict; use Tk; # Tk support is enabled if the Tk module is used before POE itself. # except when it isn't... # # ActiveState does something funky such that if you don't include # Loop::TkActiveState here Loop::Tk won't be detected. The good news # is that it does not appear to be necessary to special case this for # other platforms. use POE qw( Loop::TkActiveState ); # # when compiling with ActiveState perlapp a bunch of --add arguments # will also be needed. Saner platforms don't need this kick in the # pants. # Create the session that will drive the user interface. POE::Session->create( inline_states => { _start => \&ui_start, ev_count => \&ui_count, ev_clear => \&ui_clear, } ); # Run the program until it is exited. $poe_kernel->run(); exit 0; # Create the user interface when the session starts. This assumes # some familiarity with Tk. ui_start() illustrates four important # points. # # 1. Tk events require a main window. POE creates one for internal # use and exports it as $poe_main_window. ui_start() uses that as the # basis for its user interface. # # 2. Widgets we need to work with later, such as the counter display, # must be stored somewhere. The heap is a convenient place for them. # # 3. Tk widgets expect callbacks in the form of coderefs. The # session's postback() method provides coderefs that post events when # called. The Button created in ui_start() fires an "ev_clear" event # when it is pressed. # # 4. POE::Kernel methods such as yield(), post(), delay(), signal(), # and select() (among others) work the same as they would without Tk. # This feature makes it possible to write back end sessions that # support multiple GUIs with a single code base. sub ui_start { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; $poe_main_window->Label(-text => "Counter")->pack; $heap->{counter_widget} = $poe_main_window->Label(-textvariable => \$heap->{counter})->pack; $poe_main_window->Button( -text => "Clear", -command => $session->postback("ev_clear") )->pack; $kernel->yield("ev_count"); } # Handle the "ev_count" event by increasing a counter and displaying # its new value. sub ui_count { $_[HEAP]->{counter}++; $poe_main_window->update; # Needed on SunOS & MacOS-X $_[KERNEL]->yield("ev_count"); } # Handle the "ev_clear" event by clearing and redisplaying the # counter. sub ui_clear { $_[HEAP]->{counter} = 0; }
An RSS Newsreader
Described in http://www.stonehenge.com/merlyn/PerlJournal/col11.html.
#!/usr/bin/perl -w use strict; $|++; ## config my @FEEDS = map [split], split /\n/, <<'THE_FEEDS'; useperl|journal 90 http://use.perl.org/search.pl?op=journals&content_type=rss slashdot|journal 90 http://slashdot.org/search.pl?op=journals&content_type=rss del.icio.us 180 http://merlyn@del.icio.us/rss/ THE_FEEDS my ($DB) = glob("~/.newsee"); # save database here sub LAUNCH { system "open", shift; # open $_[0] as a URL in favorite browser } ## end config ## globals my $READER = "reader"; # alias for reader session dbmopen(my %SEEN, $DB, 0600) or die; ## end globals delete @SEEN{grep $SEEN{$_} < time - 86400 * 3, keys %SEEN}; # quick cleanup use Tk; use POE; POE::Session->create( inline_states => { _start => sub { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; require POE::Component::RSSAggregator; ## start the reader POE::Component::RSSAggregator->new( alias => $READER, callback => $session->postback('handle_feed'), ); ## set up the NoteBook require Tk::NoteBook; $heap->{nb} = $poe_main_window->NoteBook(-font => [-size => 10]) ->pack(-expand => 1, -fill => 'both'); ## add the initial subscriptions $kernel->yield(add_feed => @$_) for @FEEDS; }, add_feed => sub { my ($kernel, $session, $heap, $name, $delay, $url) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1, ARG2]; ## add a notebook page require Tk::ROText; (my $label_name = $name) =~ tr/|/\n/; my $scrolled = $heap->{nb}->add($name, -label => "$label_name: ?")->Scrolled( ROText => -scrollbars => 'oe', -spacing3 => '5', )->pack(-expand => 1, -fill => 'both'); ## set up bindings on $scrolled here $scrolled->tagConfigure('link', -font => [-weight => 'bold']); $scrolled->tagConfigure('seen'); for my $tag (qw(link seen)) { $scrolled->tagBind($tag, '<1>', [$session->postback(handle_click => $name, 1), Ev('@')]); $scrolled->tagBind($tag, '<Double-1>', [$session->postback(handle_click => $name, 2), Ev('@')]); } ## start the feed, getting callbacks $kernel->post( $READER => add_feed => {url => $url, name => $name, delay => $delay}); }, handle_click => sub { my ($kernel, $session, $heap, $postback_args, $callback_args) = @_[KERNEL, SESSION, HEAP, ARG0, ARG1]; my $name = $postback_args->[0]; my $count = $postback_args->[1]; # 1 = single click, 2 = double click my $text = $callback_args->[0]; my $at = $callback_args->[1]; my ($line) = $text->index($at) =~ /^(\d+)\.\d+$/ or die; if (my $headline = $heap->{feed}{$name}->headlines->[$line - 1]) { $SEEN{$headline->id} = time; $kernel->yield(feed_changed => $name); if ($count == 2) { # double click: open URL LAUNCH($headline->url); } } }, handle_feed => sub { my ($kernel, $session, $heap, $callback_args) = @_[KERNEL, SESSION, HEAP, ARG1]; my $feed = $callback_args->[0]; my $name = $feed->name; $heap->{feed}{$name} = $feed; $kernel->yield(feed_changed => $name); }, feed_changed => sub { my ($kernel, $session, $heap, $name) = @_[KERNEL, SESSION, HEAP, ARG0]; my $feed = $heap->{feed}{$name}; my $nb = $heap->{nb}; my $widget = $nb->page_widget($name); my $scrolled = $widget->children->[0]; ## update the text my ($pct) = $scrolled->yview; $scrolled->delete("1.0", "end"); my $new_count = 0; for my $headline (@{$feed->headlines}) { my $tag = 'link'; if ($SEEN{$headline->id}) { $tag = 'seen'; } else { $new_count++; } $scrolled->insert('end', $headline->headline, $tag); $scrolled->insert('end', "\n"); } $scrolled->yviewMoveto($pct); (my $label_name = $name) =~ tr/|/\n/; $nb->pageconfigure($name, -label => "$label_name: $new_count"); }, } ); $poe_kernel->run();