r42012 - in /branches/upstream/libobject-event-perl/current: Changes MANIFEST META.yml README lib/Object/Event.pm samples/mass_example t/05_unreg_rec.t t/06_unreg_guard.t
mxey-guest at users.alioth.debian.org
mxey-guest at users.alioth.debian.org
Mon Aug 17 15:13:26 UTC 2009
Author: mxey-guest
Date: Mon Aug 17 15:13:07 2009
New Revision: 42012
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=42012
Log:
[svn-upgrade] Integrating new upstream version, libobject-event-perl (1.1)
Added:
branches/upstream/libobject-event-perl/current/samples/mass_example (with props)
Modified:
branches/upstream/libobject-event-perl/current/Changes
branches/upstream/libobject-event-perl/current/MANIFEST
branches/upstream/libobject-event-perl/current/META.yml
branches/upstream/libobject-event-perl/current/README
branches/upstream/libobject-event-perl/current/lib/Object/Event.pm
branches/upstream/libobject-event-perl/current/t/05_unreg_rec.t
branches/upstream/libobject-event-perl/current/t/06_unreg_guard.t
Modified: branches/upstream/libobject-event-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/Changes?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/Changes (original)
+++ branches/upstream/libobject-event-perl/current/Changes Mon Aug 17 15:13:07 2009
@@ -1,6 +1,16 @@
Revision history for Object-Event:
-1.0 Mon Mar 16 21:23:02 CET 2009
+1.1 Sun Aug 9 18:05:08 CEST 2009
+ - fixed some really wrong documentation (i.e.: about return values of
+ the event method).
+ - added init method for cases where you can't use the Object::Event
+ constructor.
+ - testing for undefined $self in the guard destructor.
+ - added 'handles' method to query whether handlers exist.
+ - made the 'event' method return true or false in case
+ handlers ran.
+
+1.0 Mon Mar 16 21:23:02 CET 2009
- added stop/continue feature.
- deprecated forward feature.
(will be kept until AnyEvent::XMPP 0.4 is replaced by the new
@@ -9,7 +19,7 @@
- added syntactic sugar for using method calling syntax
as event invocation.
-0.7 Wed Feb 18 11:56:40 CET 2009
+0.7 Wed Feb 18 11:56:40 CET 2009
NOTE: This is the last release which will contain the add_forward
feature. The next release will contain some minor incompatible changes.
@@ -20,19 +30,19 @@
- added ::Methods syntactic sugar. Please note that the next
version might contain some incompatible changes here.
-0.6 Tue Sep 23 15:13:23 CEST 2008
+0.6 Tue Sep 23 15:13:23 CEST 2008
- recursive event calling now also should work properly.
-0.4 Tue Apr 15 12:48:11 CEST 2008
+0.4 Tue Apr 15 12:48:11 CEST 2008
- events can now be registered from within the
callbacks for the same object and event safely.
-0.3 Fri Mar 21 11:35:03 CET 2008
+0.3 Fri Mar 21 11:35:03 CET 2008
- fixed a serious bug in stop_event
-0.2 Fri Mar 21 01:38:12 CET 2008
+0.2 Fri Mar 21 01:38:12 CET 2008
- forgot a simple test for the event handling
- added an example
-0.1 Thu Mar 20 13:18:12 CET 2008
+0.1 Thu Mar 20 13:18:12 CET 2008
- initial release
Modified: branches/upstream/libobject-event-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/MANIFEST?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/MANIFEST (original)
+++ branches/upstream/libobject-event-perl/current/MANIFEST Mon Aug 17 15:13:07 2009
@@ -19,4 +19,5 @@
t/15_methods_subc.t
samples/simple_example
samples/benchmark
+samples/mass_example
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libobject-event-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/META.yml?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/META.yml (original)
+++ branches/upstream/libobject-event-perl/current/META.yml Mon Aug 17 15:13:07 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Object-Event
-version: 1.0
+version: 1.1
abstract: A class that provides an event callback interface
author:
- Robin Redeker <elmex at x-paste.de>
Modified: branches/upstream/libobject-event-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/README?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/README (original)
+++ branches/upstream/libobject-event-perl/current/README Mon Aug 17 15:13:07 2009
@@ -2,7 +2,7 @@
Object::Event - A class that provides an event callback interface
VERSION
- Version 1.0
+ Version 1.1
SYNOPSIS
package foo;
@@ -24,7 +24,7 @@
$regguard = undef;
DESCRIPTION
- This module was mainly written for Net::XMPP2, Net::IRC3,
+ This module was mainly written for AnyEvent::XMPP, AnyEvent::IRC,
AnyEvent::HTTPD and BS to provide a consistent API for registering and
emitting events. Even though I originally wrote it for those modules I
released it separately in case anyone may find this module useful.
@@ -36,9 +36,12 @@
You will be able to register callbacks for events, identified by their
names (a string) and call them later by invoking the "event" method with
- the event name and some arguments. For each invoked event a event
- object, derived from Object::Event::Event will be generated, which you
- can use to influence the way the event callbacks are called.
+ the event name and some arguments.
+
+ There is even a syntactic sugar which allows to call methods on the
+ instances of a from Object::Event-derived class, to invoke events. See
+ "enable_methods" below. For this feature please also consult the test
+ cases in the distribution for examples.
PERFORMANCE
In the first version as presented here no special performance
@@ -76,6 +79,10 @@
method's code as priority 0 event callback. The replacement will
happen whenever an event callback is registered with "reg_cb".
+ $obj->init_object_events ()
+ This method should only be called if you are not able to call the
+ "new" constructor of this class.
+
$obj->set_exception_cb ($cb->($exception, $eventname))
This method installs a callback that will be called when some other
event callback threw an exception. The first argument to $cb will be
@@ -96,10 +103,21 @@
the event object $ev (which represents an event which was sent by
the "event" method) as first argument use the "reg_event_cb" method.
- The callbacks will be called in an array context. If a callback
- doesn't want to return any value it should return an empty list. All
- results from the callbacks will be appended and returned by the
- "event" method.
+ The return value of the callbacks are ignored. If you need to pass
+ any information from a handler to the caller of the event you have
+ to establish your own "protocol" to do this. I recommend to pass an
+ array reference to the handlers:
+
+ $obj->reg_cb (event_foobar => sub {
+ my ($self, $results) = @_;
+ push @$results, time / 30;
+ });
+
+ my @results;
+ $obj->event (event_foobar => \@results);
+ for (@results) {
+ # ...
+ }
The order of the callbacks in the call chain of the event depends on
their priority. If you didn't specify any priority (see below) they
@@ -124,10 +142,13 @@
$obj->event ($eventname, @args)
Emits the event $eventname and passes the arguments @args to the
- callbacks. The return value is an object which is derived from
- Object::Event::Event, and acts as handle to this event invocation.
-
- See also the alternate form to call "event" below.
+ callbacks. The return value is a true value in case some handler was
+ found and run. It returns false if no handler was found (see also
+ the "handles" method below). Basically: It returns the same value as
+ the "handles" method.
+
+ Please note that an event can be stopped and reinvoked while it is
+ being handled.
See also the specification of the before and after events in
"reg_cb" above.
@@ -138,20 +159,27 @@
will be called the next time when the event is emitted. Example:
$obj->reg_cb (event_test => sub {
- my ($ev) = @_;
+ my ($obj) = @_;
print "Test1\n";
- $ev->unreg_me;
+ $obj->unreg_me;
$obj->reg_cb (event_test => sub {
- my ($ev) = @_;
+ my ($obj) = @_;
print "Test2\n";
- $ev->unreg_me;
+ $obj->unreg_me;
});
});
$obj->event ('event_test'); # prints "Test1"
$obj->event ('event_test'); # prints "Test2"
+
+ my $bool = $obj->handles ($eventname)
+ This method returns true if any event handler (either registered via
+ "reg_cb" or by a method definition if "enable_methods" is enabled)
+ has been setup for the event $eventname.
+
+ It returns false if that is not the case.
$obj->event_name
Returns the name of the currently executed event.
@@ -248,6 +276,12 @@
<http://search.cpan.org/dist/Object-Event>
+ACKNOWLEDGEMENTS
+ Thanks go to:
+
+ - Mons Anderson for suggesting the 'handles' method and
+ the return value of the 'event' method and reporting bugs.
+
COPYRIGHT & LICENSE
Copyright 2009 Robin Redeker, all rights reserved.
Modified: branches/upstream/libobject-event-perl/current/lib/Object/Event.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/lib/Object/Event.pm?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/lib/Object/Event.pm (original)
+++ branches/upstream/libobject-event-perl/current/lib/Object/Event.pm Mon Aug 17 15:13:07 2009
@@ -12,11 +12,11 @@
=head1 VERSION
-Version 1.0
-
-=cut
-
-our $VERSION = '1.0';
+Version 1.1
+
+=cut
+
+our $VERSION = '1.1';
=head1 SYNOPSIS
@@ -41,7 +41,7 @@
=head1 DESCRIPTION
-This module was mainly written for L<Net::XMPP2>, L<Net::IRC3>,
+This module was mainly written for L<AnyEvent::XMPP>, L<AnyEvent::IRC>,
L<AnyEvent::HTTPD> and L<BS> to provide a consistent API for registering and
emitting events. Even though I originally wrote it for those modules I released
it separately in case anyone may find this module useful.
@@ -53,9 +53,12 @@
You will be able to register callbacks for events, identified by their names (a
string) and call them later by invoking the C<event> method with the event name
-and some arguments. For each invoked event a event object, derived from
-L<Object::Event::Event> will be generated, which you can use to influence the
-way the event callbacks are called.
+and some arguments.
+
+There is even a syntactic sugar which allows to call methods on the
+instances of a from L<Object::Event>-derived class, to invoke events.
+See C<enable_methods> below. For this feature please also consult the
+test cases in the distribution for examples.
=head1 PERFORMANCE
@@ -132,21 +135,36 @@
sub new {
my $this = shift;
- my $class = ref($this) || $this;
- my $self = {
- enable_methods => $ENABLE_METHODS_DEFAULT,
- @_,
- };
+ my $class = ref ($this) || $this;
+ my $self = { @_ };
bless $self, $class;
+
+ $self->init_object_events;
+
+ return $self
+}
+
+=item $obj->init_object_events ()
+
+This method should only be called if you are not able to call the C<new>
+constructor of this class.
+
+=cut
+
+sub init_object_events {
+ my ($self) = @_;
+
+ unless (defined $self->{enable_methods}) {
+ $self->{enable_methods} = $ENABLE_METHODS_DEFAULT;
+ }
if ($self->{enable_methods}) {
no strict 'refs';
+ my $class = ref $self;
for my $ev (keys %{"$class\::__OE_INHERITED_METHODS"}) {
$self->_check_method ($ev)
}
}
-
- return $self
}
=item $obj->set_exception_cb ($cb->($exception, $eventname))
@@ -178,9 +196,21 @@
C<$ev> (which represents an event which was sent by the C<event> method) as
first argument use the C<reg_event_cb> method.
-The callbacks will be called in an array context. If a callback doesn't want to
-return any value it should return an empty list. All results from the callbacks
-will be appended and returned by the C<event> method.
+The return value of the callbacks are ignored. If you need to pass
+any information from a handler to the caller of the event you have to
+establish your own "protocol" to do this. I recommend to pass an array
+reference to the handlers:
+
+ $obj->reg_cb (event_foobar => sub {
+ my ($self, $results) = @_;
+ push @$results, time / 30;
+ });
+
+ my @results;
+ $obj->event (event_foobar => \@results);
+ for (@results) {
+ # ...
+ }
The order of the callbacks in the call chain of the event depends on their
priority. If you didn't specify any priority (see below) they get the default
@@ -248,7 +278,7 @@
}
defined wantarray
- ? \(my $g = guard { $self->unreg_cb ($_) for @cbs })
+ ? \(my $g = guard { if ($self) { $self->unreg_cb ($_) for @cbs } })
: ()
}
@@ -277,10 +307,12 @@
=item $obj->event ($eventname, @args)
Emits the event C<$eventname> and passes the arguments C<@args> to the
-callbacks. The return value is an object which is derived from
-L<Object::Event::Event>, and acts as handle to this event invocation.
-
-See also the alternate form to call C<event> below.
+callbacks. The return value is a true value in case some handler was found
+and run. It returns false if no handler was found (see also the C<handles>
+method below). Basically: It returns the same value as the C<handles> method.
+
+Please note that an event can be stopped and reinvoked while it is being
+handled.
See also the specification of the before and after events in C<reg_cb> above.
@@ -290,15 +322,15 @@
when the event is emitted. Example:
$obj->reg_cb (event_test => sub {
- my ($ev) = @_;
+ my ($obj) = @_;
print "Test1\n";
- $ev->unreg_me;
+ $obj->unreg_me;
$obj->reg_cb (event_test => sub {
- my ($ev) = @_;
+ my ($obj) = @_;
print "Test2\n";
- $ev->unreg_me;
+ $obj->unreg_me;
});
});
@@ -356,7 +388,8 @@
warn "unhandled callback exception on event ($ev, $self, @arg): $@\n";
}
}
- ()
+
+ @cbs > 0
};
}
}
@@ -428,7 +461,26 @@
}
}
- ()
+ @cbs > 0
+}
+
+=item my $bool = $obj->handles ($eventname)
+
+This method returns true if any event handler (either registered via C<reg_cb>
+or by a method definition if C<enable_methods> is enabled) has been setup for
+the event C<$eventname>.
+
+It returns false if that is not the case.
+
+=cut
+
+sub handles {
+ my ($self, $ev) = @_;
+
+ $self->_check_method ($ev) if $self->{enable_methods};
+
+ exists $self->{__oe_events}->{$ev}
+ && @{$self->{__oe_events}->{$ev}} > 0
}
=item $obj->event_name
@@ -480,7 +532,7 @@
$self->{__oe_forward_stop} = 1;
@{$self->{__oe_cbs}->[0]} = ();
-
+
$r
}
@@ -659,6 +711,13 @@
=back
+=head1 ACKNOWLEDGEMENTS
+
+Thanks go to:
+
+ - Mons Anderson for suggesting the 'handles' method and
+ the return value of the 'event' method and reporting bugs.
+
=head1 COPYRIGHT & LICENSE
Copyright 2009 Robin Redeker, all rights reserved.
Added: branches/upstream/libobject-event-perl/current/samples/mass_example
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/samples/mass_example?rev=42012&op=file
==============================================================================
--- branches/upstream/libobject-event-perl/current/samples/mass_example (added)
+++ branches/upstream/libobject-event-perl/current/samples/mass_example Mon Aug 17 15:13:07 2009
@@ -1,0 +1,41 @@
+#!/opt/perl/bin/perl
+# just a small example script for testing whether memory might be leaked.
+
+package test;
+
+use Object::Event;
+
+our @ISA = qw/Object::Event/;
+
+sub new {
+ my $c = shift;
+ my $self = $c->SUPER::new (@_);
+
+ # register on the 'up' event and then call the 'down' event
+ $self->reg_cb (up => sub { $self->event ('down'); });
+
+ $self
+}
+
+sub up {
+ my ($self) = @_;
+
+ $self->event ('up'); # genereate an internal up event
+}
+
+package main;
+
+my $t = test->new;
+
+my $cnt = 0;
+$t->reg_cb ( # reg_cb registers on a set of specific events
+ down => sub {
+ my ($t) = @_;
+ $cnt++;
+ }
+);
+
+for (1..1000000) {
+ $t->up; # test will emit the 'down' even we registered upon above
+ if ($cnt % 1000) { print "$cnt\n" }
+}
Propchange: branches/upstream/libobject-event-perl/current/samples/mass_example
------------------------------------------------------------------------------
svn:executable = *
Modified: branches/upstream/libobject-event-perl/current/t/05_unreg_rec.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/t/05_unreg_rec.t?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/t/05_unreg_rec.t (original)
+++ branches/upstream/libobject-event-perl/current/t/05_unreg_rec.t Mon Aug 17 15:13:07 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 2;
+use Test::More tests => 6;
package foo;
use strict;
@@ -35,10 +35,16 @@
}
);
+ok ($f->handles ('test'), "handles 'test'");
+ok ($f->handles ('test2'), "handles 'test2'");
+
$f->event ('test');
$f->event ('test');
$f->event ('test2');
$f->event ('test2');
+ok (!$f->handles ('test'), "doesn't handle 'test'");
+ok (!$f->handles ('test2'), "doesn't handle 'test2'");
+
is ($a, 1, 'first callback was called once');
is ($b, 1, 'second callback was called once');
Modified: branches/upstream/libobject-event-perl/current/t/06_unreg_guard.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libobject-event-perl/current/t/06_unreg_guard.t?rev=42012&op=diff
==============================================================================
--- branches/upstream/libobject-event-perl/current/t/06_unreg_guard.t (original)
+++ branches/upstream/libobject-event-perl/current/t/06_unreg_guard.t Mon Aug 17 15:13:07 2009
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 2;
+use Test::More tests => 4;
package foo;
use strict;
@@ -24,9 +24,12 @@
$f->event (test => 10);
is ($called, 10, "first test called once");
+ok ($f->handles ('test'), "got a handler");
$f->unreg_cb ($id);
$f->event (test => 20);
is ($called, 10, "second test still called once");
+
+ok (!$f->handles ('test'), "no handler anymore");
More information about the Pkg-perl-cvs-commits
mailing list