r71224 - in /trunk/libobject-event-perl: ./ debian/ lib/Object/ t/
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Mar 12 01:24:08 UTC 2011
Author: jawnsy-guest
Date: Sat Mar 12 01:23:45 2011
New Revision: 71224
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=71224
Log:
* New upstream release
* Slight rewrite to control description
* Bump to debhelper compat 8
* Standards-Version 3.9.1 (specifically refer to GPL-1)
* Refresh copyright information
Added:
trunk/libobject-event-perl/META.json
- copied unchanged from r71220, branches/upstream/libobject-event-perl/current/META.json
trunk/libobject-event-perl/t/18_method_inherit_2.t
- copied unchanged from r71220, branches/upstream/libobject-event-perl/current/t/18_method_inherit_2.t
Removed:
trunk/libobject-event-perl/debian/README.source
Modified:
trunk/libobject-event-perl/Changes
trunk/libobject-event-perl/MANIFEST
trunk/libobject-event-perl/META.yml
trunk/libobject-event-perl/README
trunk/libobject-event-perl/debian/changelog
trunk/libobject-event-perl/debian/compat
trunk/libobject-event-perl/debian/control
trunk/libobject-event-perl/debian/copyright
trunk/libobject-event-perl/debian/rules
trunk/libobject-event-perl/lib/Object/Event.pm
trunk/libobject-event-perl/t/06_unreg_guard.t
trunk/libobject-event-perl/t/13_methods.t
Modified: trunk/libobject-event-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/Changes?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/Changes (original)
+++ trunk/libobject-event-perl/Changes Sat Mar 12 01:23:45 2011
@@ -1,4 +1,8 @@
Revision history for Object-Event:
+
+1.22 Thu Mar 10 17:17:58 CET 2011
+ - fixed a bug where event methods were not registered correctly.
+ - found a bug with using the guard to track cb registrations.
1.21 Thu Nov 5 19:37:58 CET 2009
- fixed a bug in the legacy forward code to support the old
Modified: trunk/libobject-event-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/MANIFEST?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/MANIFEST (original)
+++ trunk/libobject-event-perl/MANIFEST Sat Mar 12 01:23:45 2011
@@ -20,9 +20,11 @@
t/16_event.t
t/17_methods_alias.t
t/18_method_inherit.t
+t/18_method_inherit_2.t
t/19_method_exept.t
t/20_forward_legacy.t
samples/simple_example
samples/benchmark
samples/mass_example
META.yml Module meta-data (added by MakeMaker)
+META.json Module meta-data (added by MakeMaker)
Modified: trunk/libobject-event-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/META.yml?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/META.yml (original)
+++ trunk/libobject-event-perl/META.yml Sat Mar 12 01:23:45 2011
@@ -1,24 +1,32 @@
---- #YAML:1.0
-name: Object-Event
-version: 1.21
-abstract: A class that provides an event callback interface
-author:
- - Robin Redeker <elmex at x-paste.de>
-license: perl
-distribution_type: module
-configure_requires:
- ExtUtils::MakeMaker: 0
-build_requires:
- ExtUtils::MakeMaker: 0
-requires:
- AnyEvent: 3.5
- common::sense: 0
- Test::More: 0
-no_index:
- directory:
- - t
- - inc
-generated_by: ExtUtils::MakeMaker version 6.55_02
-meta-spec:
- url: http://module-build.sourceforge.net/META-spec-v1.4.html
- version: 1.4
+{
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "meta-spec" : {
+ "version" : 1.4,
+ "url" : "http://module-build.sourceforge.net/META-spec-v1.4.html"
+ },
+ "generated_by" : "ExtUtils::MakeMaker version 6.56",
+ "distribution_type" : "module",
+ "version" : "1.22",
+ "name" : "Object-Event",
+ "author" : [
+ "Robin Redeker <elmex at x-paste.de>"
+ ],
+ "license" : "perl",
+ "build_requires" : {
+ "ExtUtils::MakeMaker" : 0
+ },
+ "requires" : {
+ "Test::More" : 0,
+ "AnyEvent" : 3.5,
+ "common::sense" : 0
+ },
+ "abstract" : "A class that provides an event callback interface",
+ "configure_requires" : {
+ "ExtUtils::MakeMaker" : 0
+ }
+}
Modified: trunk/libobject-event-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/README?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/README (original)
+++ trunk/libobject-event-perl/README Sat Mar 12 01:23:45 2011
@@ -2,7 +2,7 @@
Object::Event - A class that provides an event callback interface
VERSION
- Version 1.21
+ Version 1.22
SYNOPSIS
package foo;
Modified: trunk/libobject-event-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/debian/changelog?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/debian/changelog (original)
+++ trunk/libobject-event-perl/debian/changelog Sat Mar 12 01:23:45 2011
@@ -1,8 +1,12 @@
-libobject-event-perl (1.210-2) UNRELEASED; urgency=low
+libobject-event-perl (1.220-1) UNRELEASED; urgency=low
- * debian/rules: switch order of arguments to dh.
+ * New upstream release
+ * Slight rewrite to control description
+ * Bump to debhelper compat 8
+ * Standards-Version 3.9.1 (specifically refer to GPL-1)
+ * Refresh copyright information
- -- gregor herrmann <gregoa at debian.org> Wed, 28 Jul 2010 14:33:06 -0400
+ -- Jonathan Yu <jawnsy at cpan.org> Fri, 11 Mar 2011 20:48:15 -0500
libobject-event-perl (1.210-1) unstable; urgency=low
Modified: trunk/libobject-event-perl/debian/compat
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/debian/compat?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/debian/compat (original)
+++ trunk/libobject-event-perl/debian/compat Sat Mar 12 01:23:45 2011
@@ -1,1 +1,1 @@
-7
+8
Modified: trunk/libobject-event-perl/debian/control
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/debian/control?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/debian/control (original)
+++ trunk/libobject-event-perl/debian/control Sat Mar 12 01:23:45 2011
@@ -1,21 +1,25 @@
Source: libobject-event-perl
Section: perl
Priority: optional
-Build-Depends: debhelper (>= 7.0.8), quilt (>= 0.46-7)
-Build-Depends-Indep: perl, libanyevent-perl (>= 3.5), libcommon-sense-perl
+Build-Depends: debhelper (>= 8)
+Build-Depends-Indep: perl,
+ libanyevent-perl (>= 3.5),
+ libcommon-sense-perl
Maintainer: Debian Perl Group <pkg-perl-maintainers at lists.alioth.debian.org>
Uploaders: Maximilian Gass <mxey at cloudconnected.org>,
Jonathan Yu <jawnsy at cpan.org>
-Standards-Version: 3.8.3
+Standards-Version: 3.9.1
Homepage: http://search.cpan.org/dist/Object-Event/
Vcs-Svn: svn://svn.debian.org/pkg-perl/trunk/libobject-event-perl/
Vcs-Browser: http://svn.debian.org/viewsvn/pkg-perl/trunk/libobject-event-perl/
Package: libobject-event-perl
Architecture: all
-Depends: ${perl:Depends}, ${misc:Depends}, libanyevent-perl (>= 3.5),
+Depends: ${perl:Depends}, ${misc:Depends},
+ libanyevent-perl (>= 3.5),
libcommon-sense-perl
Description: Perl event callback interface
- Object::Event provides a consistent API for registering and emitting events.
- You can register callbacks for events, trigger events and even stop the
- current event from running further callbacks.
+ Object::Event is a Perl module that provides a consistent interface for
+ registering and emitting events. You can register callbacks for events,
+ trigger events and even stop the current event from running further
+ callbacks.
Modified: trunk/libobject-event-perl/debian/copyright
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/debian/copyright?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/debian/copyright (original)
+++ trunk/libobject-event-perl/debian/copyright Sat Mar 12 01:23:45 2011
@@ -1,29 +1,29 @@
-Format-Specification:
- http://wiki.debian.org/Proposals/CopyrightFormat?action=recall&rev=196
-Upstream-Maintainer: Robin Redeker <elmex at x-paste.de>
-Upstream-Source: http://search.cpan.org/dist/Object-Event/
-Upstream-Name: Object-Event
+Format-Specification: http://svn.debian.org/wsvn/dep/web/deps/dep5.mdwn?op=file&rev=135
+Maintainer: Robin Redeker <elmex at ta-sa.org>
+Source: http://search.cpan.org/dist/Object-Event/
+Name: Object-Event
Files: *
-Copyright: 2009, Robin Redeker <elmex at x-paste.de>
-License-Alias: Perl
-License: Artistic | GPL-1+
+Copyright: 2009, Robin Redeker <elmex at ta-sa.org>
+License: Artistic or GPL-1+
Files: debian/*
-Copyright: 2009, Maximilian Gaß <mxey at cloudconnected.org>
- 2009, Jonathan Yu <jawnsy at cpan.org>
-License: Artistic | GPL-1+
+Copyright: 2009-2011, Jonathan Yu <jawnsy at cpan.org>
+ 2009, Maximilian Gaß <mxey at cloudconnected.org>
+License: Artistic or GPL-1+
License: Artistic
- This program is free software; you can redistribute it and/or modify
- it under the terms of the Artistic License, which comes with Perl.
- On Debian GNU/Linux systems, the complete text of the Artistic License
- can be found in `/usr/share/common-licenses/Artistic'
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the Artistic License, which comes with Perl.
+ .
+ On Debian systems, the complete text of the Artistic License can be
+ found in `/usr/share/common-licenses/Artistic'.
License: GPL-1+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 1, or (at your option)
- any later version.
- On Debian GNU/Linux systems, the complete text of the GNU General
- Public License can be found in `/usr/share/common-licenses/GPL'
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+ .
+ On Debian systems, the complete text of version 1 of the GNU General
+ Public License can be found in `/usr/share/common-licenses/GPL-1'.
Modified: trunk/libobject-event-perl/debian/rules
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/debian/rules?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/debian/rules (original)
+++ trunk/libobject-event-perl/debian/rules Sat Mar 12 01:23:45 2011
@@ -1,4 +1,4 @@
#!/usr/bin/make -f
%:
- dh $@ --with quilt
+ dh $@
Modified: trunk/libobject-event-perl/lib/Object/Event.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/lib/Object/Event.pm?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/lib/Object/Event.pm (original)
+++ trunk/libobject-event-perl/lib/Object/Event.pm Sat Mar 12 01:23:45 2011
@@ -13,11 +13,11 @@
=head1 VERSION
-Version 1.21
-
-=cut
-
-our $VERSION = '1.21';
+Version 1.22
+
+=cut
+
+our $VERSION = '1.22';
=head1 SYNOPSIS
@@ -146,6 +146,8 @@
_init_methods ($pkg) unless *{"$pkg\::__OE_METHODS"}{HASH};
+ $self->{__oe_cb_gen} = "a"; # generation counter
+
$self->{__oe_events} = {
map {
($_ => [@{${"$pkg\::__OE_METHODS"}{$_}}])
@@ -256,7 +258,7 @@
}
sub _register_event_struct {
- my ($self, $event, $prio, $callback, $debug) = @_;
+ my ($self, $event, $prio, $gen, $callback, $debug) = @_;
my $reg = ($self->{__oe_events} ||= {});
my $idx = 0;
@@ -271,7 +273,7 @@
my $cb = $callback;
$cb = _debug_cb ($callback) if $DEBUG > 1;
- splice @$evlist, $idx, 0, [$prio, "$callback", undef, $debug, $cb];
+ splice @$evlist, $idx, 0, [$prio, "$callback|$gen", undef, $debug, $cb];
}
sub reg_cb {
@@ -286,6 +288,8 @@
$debuginfo = sprintf "%s:%d (%s::)", $file, $line, $pkg;
}
+ my $gen = $self->{__oe_cb_gen}++; # get gen counter
+
my @cbs;
while (@args) {
my ($ev, $sec) = (shift @args, shift @args);
@@ -307,12 +311,12 @@
$cb = shift @args;
}
- $self->_register_event_struct ($ev, $prio, $cb, $debuginfo);
+ $self->_register_event_struct ($ev, $prio, $gen, $cb, $debuginfo);
push @cbs, $cb;
}
defined wantarray
- ? \(my $g = guard { if ($self) { $self->unreg_cb ($_) for @cbs } })
+ ? \(my $g = guard { if ($self) { $self->unreg_cb ($_, $gen) for @cbs } })
: ()
}
@@ -323,7 +327,7 @@
=cut
sub unreg_cb {
- my ($self, $cb) = @_;
+ my ($self, $cb, $gen) = @_;
if (ref ($cb) eq 'REF') {
# we've got a guard object
@@ -333,8 +337,18 @@
my $evs = $self->{__oe_events};
+ # $gen is neccessary for the times where we use the guard to remove
+ # something, because we only have the callback as ID we need to track the
+ # generation of the registration for these:
+ #
+ # my $cb = sub { ... };
+ # my $g = $o->reg_cb (a => $cb);
+ # $g = $o->reg_cb (a => $cb);
+ my ($key, $key_len) = defined $gen
+ ? ("$cb|$gen", length "$cb|$gen")
+ : ("$cb", length "$cb");
for my $reg (values %$evs) {
- @$reg = grep { $_->[1] ne $cb } @$reg;
+ @$reg = grep { (substr $_->[1], 0, $key_len) ne $key } @$reg;
}
}
@@ -742,26 +756,29 @@
sub _init_methods {
my ($pkg) = @_;
- my $sup = \%{"$pkg\::__OE_METHODS"};
-
- for my $superpkg (@{"$pkg\::ISA"}) {
- next unless $superpkg->isa ("Object::Event");
-
+ my $pkg_meth = \%{"$pkg\::__OE_METHODS"};
+
+ for my $superpkg (@{"$pkg\::ISA"}) { # go recursively into super classes
+ next unless $superpkg->isa ("Object::Event"); # skip non O::E
+
+ # go into the class if we have not already been there
_init_methods ($superpkg)
unless *{"$superpkg\::__OE_METHODS"}{HASH};
+ # add the methods of the $superpkg to our own
for (keys %{"$superpkg\::__OE_METHODS"}) {
- push @{$sup->{$_}}, @{${"$superpkg\::__OE_METHODS"}{$_} || []};
+ push @{$pkg_meth->{$_}}, @{${"$superpkg\::__OE_METHODS"}{$_} || []};
}
}
my %mymethds;
+ # now check each package symbol
for my $realmeth (keys %{"$pkg\::"}) {
my $coderef = *{"$pkg\::$realmeth"}{CODE};
- next unless exists $ATTRIBUTES{$pkg}->{"$coderef"};
- my $m = $ATTRIBUTES{$pkg}->{"$coderef"};
+ next unless exists $ATTRIBUTES{$pkg}->{"$coderef"}; # skip unattributed methods
+ my $m = $ATTRIBUTES{$pkg}->{"$coderef"}; # $m = [$prio, $event_name]
my $meth = $realmeth;
@@ -776,30 +793,37 @@
(exists $PRIO_MAP{$m->[0]} # set priority
? $PRIO_MAP{$m->[0]}
: 0+$m->[0]),
- "$coderef",
- $realmeth,
- $pkg . '::' . $realmeth,
- $cb
- ] if defined &{"$pkg\::$meth"};
-
- #d# warn "REPLACED $pkg $meth => $coderef ($m->[1])\n";
+ "$coderef", # callback id
+ $realmeth, # original method name
+ $pkg . '::' . $realmeth, # debug info
+ $cb # the callback
+
+ # only replace if defined, otherwise declarations without definitions will
+ # replace the $cb/$coderef with something that calls itself recursively.
+
+ ] if defined &{"$pkg\::$realmeth"};
+
+ #d# warn "REPLACED $pkg $meth (by $realmeth) => $coderef ($m->[1])\n";
_replace_method ($pkg, $realmeth, $meth);
}
+ # sort my methods by name
for my $ev (keys %mymethds) {
@{$mymethds{$ev}} =
sort { $a->[2] cmp $b->[2] }
@{$mymethds{$ev}};
}
- push @{$sup->{$_}}, @{$mymethds{$_}}
+ # add my methods to the super class method list
+ push @{$pkg_meth->{$_}}, @{$mymethds{$_}}
for keys %mymethds;
- for my $ev (keys %$sup) {
- @{$sup->{$ev}} =
+ # sort by priority over all, stable to not confuse names
+ for my $ev (keys %$pkg_meth) {
+ @{$pkg_meth->{$ev}} =
sort { $b->[0] <=> $a->[0] }
- @{$sup->{$ev}};
+ @{$pkg_meth->{$ev}};
}
}
Modified: trunk/libobject-event-perl/t/06_unreg_guard.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/t/06_unreg_guard.t?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/t/06_unreg_guard.t (original)
+++ trunk/libobject-event-perl/t/06_unreg_guard.t Sat Mar 12 01:23:45 2011
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 4;
+use Test::More tests => 5;
package foo;
use common::sense;
@@ -31,3 +31,11 @@
is ($called, 10, "second test still called once");
ok (!$f->handles ('test'), "no handler anymore");
+
+$called = 0;
+my $sub = sub { $called++ };
+$id = $f->reg_cb (t => $sub);
+$f->event ('t');
+$id = $f->reg_cb (t => $sub);
+$f->event ('t');
+is ($called, 2, "guard removal on assignment correct");
Modified: trunk/libobject-event-perl/t/13_methods.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libobject-event-perl/t/13_methods.t?rev=71224&op=diff
==============================================================================
--- trunk/libobject-event-perl/t/13_methods.t (original)
+++ trunk/libobject-event-perl/t/13_methods.t Sat Mar 12 01:23:45 2011
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 11;
+use Test::More tests => 12;
package foo;
use common::sense;
@@ -19,6 +19,8 @@
sub pt : event_cb { push @{$_[0]->{a}}, 20 }
sub foobar : event_cb;
+
+sub foozzz : event_cb(, foobar);
package foo2;
use base qw/foo/;
@@ -53,6 +55,10 @@
is ($f->{b}, 10, 'first object got method with event callback');
is ($f2->{b}, undef, 'second object doesn\'t have method with event callback');
+$f->{b} = 0;
+$f->foozzz;
+is ($f->{b}, 10, 'first object got method with event callback with alias method');
+
ok ($f->event ('test'), 'event returns true for methods');
my $g = foo3->new;
More information about the Pkg-perl-cvs-commits
mailing list