PApp::Event - catch/broadcast various events

PApp documentation Contained in the PApp distribution.

Index

Code Index:

NAME

Top

PApp::Event - catch/broadcast various events

SYNOPSIS

Top

 use PApp::Event;

DESCRIPTION

Top

This module allows you to broadcast asynchroneous events to all other papp applications.

Why is this useful? A common scenario is this: Often you want to implement some internal data caching. PApp itself caches it's translation files, content management systems often cache frequently-used content objects.

Whenever these caches are invalidated, one papp application (or an external program) needs to signal all running application instances (maybe even on multiple machines) to delete all or some specific cache entry.

This is what this module is for.

on "event_type" => \&coderef

Register a handler that is called on the named event. The handler will receive the event_type as first argument. The remaining arguments consist of all the scalars that have been broadcasted (i.e. multiple events of the same type get "bundled" into one call), sorted in the order of submittal, i.e. the newest event data comes last.

When called in a scalar context (as opposed to void context), it returns an a handler id. When this handler id is destroyed (e.g. by going out of scope), the handler itself will be removed.

The current contents of $PApp::SQL::Database/DBH will be saved and restored while the handler runs.

broadcast "event_type" => $data[, $data...]

Broadcast an event of the named type, together with any number of scalars (each representing a single event!). The event handlers registered in the current process for the given type will be executed before this call returns, other events might or might not be processed. If you want to force processing of events, call PApp::Event::check.

check

Check for any outstanding events and execute them, if any.

Example

Top

This example implements caching of a costly operation in a local hash:

  our %cache;

  sub fetch_element {
     my $id = shift;

     return
        $cache{$id}
           ||= costly_operation (sql_fetch "...", $id));
  }

costly_operation will only be run when the %cache doesn't yet contain a cached version. Whenever the SQL database is updated, all other clients must invalidate their caches. A simple version (that just removes ALL entries) is this:

  PApp::Event::on demo_flush_cache => sub {
     %cache = ();
  };

  # after changes in the database:
  PApp::Event::broadcast demo_flush_cache => undef;

A more efficient version (when updates are frequent) only deletes the entries that were updated. The $id is given as the argument to broadcast (which only accepts a single scalar). The on-handler, however, receives all arguments in one run:

  PApp::Event::on demo_flush_cache => sub {
     shift; # get rid of event_type
     delete $cache{$_} for @_; # iterate over all arguments
  };

  # after changes in the database:
  PApp::Event::broadcast demo_flush_cache => $id;

SEE ALSO

Top

PApp.

AUTHOR

Top

 Marc Lehmann <schmorp@schmorp.de>
 http://home.schmorp.de/
PApp documentation Contained in the PApp distribution. 
##########################################################################
## All portions of this code are copyright (c) 2003,2004 nethype GmbH   ##
##########################################################################
## Using, reading, modifying or copying this code requires a LICENSE    ##
## from nethype GmbH, Franz-Werfel-Str. 11, 74078 Heilbronn,            ##
## Germany. If you happen to have questions, feel free to contact us at ##
## license@nethype.de.                                                  ##
##########################################################################


package PApp::Event;

require 5.006;

use PApp::SQL;
use PApp::Config qw(DBH $DBH); DBH;
use PApp::Exception ();
use Compress::LZF ':freeze';

$VERSION = 1.45;

our $event_count;


sub PApp::Event::handler::DESTROY {
   my $handlers = $handler{$_[0][0]};

   for (0 .. $#handlers) {
      if ($handlers[$_] == $_[0][1]) {
         splice @$handlers, $_, 1;
         return;
      }
   }

}

sub on ($&) {
   my $handler = [$_[1], $PApp::SQL::Database];

   push @{$handler{$_[0]}}, $handler;
   no warnings;
   return bless [ $_[0], $handler ], PApp::Event::handler:: if defined wantarray;
}


sub broadcast($;@) {
   my $event = shift;
   my $id;

   sql_exec $DBH, "lock tables event write, event_count write";

   for (@_) {
      #use PApp::Util; print STDERR "broadcast $event: ", PApp::Util::dumpval $_, "\n";#d#

      $id = sql_insertid sql_exec $DBH,
                  "insert into event (id, ctime, event, data) values (NULL,NULL,?,?)",
                  $event, sfreeze_cr $_;

   }
   sql_exec $DBH, "update event_count set count = ? where count < ?", $id, $id;

   sql_exec $DBH, "unlock table";

   if (@_) {
      $id > $event_count
         or die "FATAL: event table corrupted; new id $id <= current event_count $event_count";

      handle_events ($id) if @_;
   }
}

sub skip_all_events {
   $event_count = eval { sql_fetch $DBH, "select count from event_count" };
}

skip_all_events;


sub check() {
   handle_events (sql_fetch $DBH, "select count from event_count");
}

sub handle_event {
   for (@{$handler{$_[0]}}) {
      local $PApp::SQL::Database = $_->[1];
      local $PApp::SQL::DBH      = $_->[1] ? $_->[1]->checked_dbh : ();

      &{$_->[0]};
   }
}

sub handle_events {
   my $new_count = $_[0];

   return if $new_count == $event_count;

   my $st = sql_exec $DBH,
                     \my($event, $data),
                     "select event, data
                                            from event
                                            where id > ? and id <= ?
                                            order by id, event",
                     $event_count, $new_count;
   $event_count = $new_count;

   my $levent;
   my @ldata;

   while ($st->fetch) {
      if ($levent ne $event) {
         handle_event $levent, @ldata if @ldata;
         $levent = $event;
         @ldata = ();
      }
      push @ldata, sthaw $data;
   }

   handle_event $levent, @ldata if @ldata;
}

1;