#!/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();