Object-Pluggable-1.29000755001750001750 011453754351 14516 5ustar00hinrikhinrik000000000000README000644001750001750 3313611453754351 15504 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29NAME Object::Pluggable - A base class for creating plugin-enabled objects SYNOPSIS # A simple POE Component that sends ping events to registered sessions # and plugins every second. { package SimplePoCo; use strict; use warnings; use base qw(Object::Pluggable); use POE; use Object::Pluggable::Constants qw(:ALL); sub spawn { my ($package, %opts) = @_; my $self = bless \%opts, $package; $self->_pluggable_init( prefix => 'simplepoco_', types => [qw(EXAMPLE)], debug => 1, ); POE::Session->create( object_states => [ $self => { shutdown => '_shutdown' }, $self => [qw(_send_ping _start register unregister __send_event)], ], ); return $self; } sub shutdown { my ($self) = @_; $poe_kernel->post($self->{session_id}, 'shutdown'); } sub _pluggable_event { my ($self) = @_; $poe_kernel->post($self->{session_id}, '__send_event', @_); } sub _start { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->{session_id} = $_[SESSION]->ID(); if ($self->{alias}) { $kernel->alias_set($self->{alias}); } else { $kernel->refcount_increment($self->{session_id}, __PACKAGE__); } $kernel->delay(_send_ping => $self->{time} || 300); return; } sub _shutdown { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->_pluggable_destroy(); $kernel->alarm_remove_all(); $kernel->alias_remove($_) for $kernel->alias_list(); $kernel->refcount_decrement($self->{session_id}, __PACKAGE__) if !$self->{alias}; $kernel->refcount_decrement($_, __PACKAGE__) for keys %{ $self->{sessions} }; return; } sub register { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); $self->{sessions}->{$sender_id}++; if ($self->{sessions}->{$sender_id} == 1) { $kernel->refcount_increment($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_registered', $sender_id); } return; } sub unregister { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); my $record = delete $self->{sessions}->{$sender_id}; if ($record) { $kernel->refcount_decrement($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_unregistered', $sender_id); } return; } sub __send_event { my ($kernel, $self, $event, @args) = @_[KERNEL, OBJECT, ARG0..$#_]; return 1 if $self->_pluggable_process(EXAMPLE => $event, \@args) == PLUGIN_EAT_ALL; $kernel->post($_, $event, @args) for keys %{ $self->{sessions} }; } sub _send_ping { my ($kernel, $self) = @_[KERNEL, OBJECT]; $kernel->yield(__send_event => 'simplepoco_ping', 'Wake up sleepy'); $kernel->delay(_send_ping => $self->{time} || 1); return; } } { package SimplePoCo::Plugin; use strict; use warnings; use Object::Pluggable::Constants qw(:ALL); sub new { my $package = shift; return bless { @_ }, $package; } sub plugin_register { my ($self, $pluggable) = splice @_, 0, 2; print "Plugin added\n"; $pluggable->plugin_register($self, 'EXAMPLE', 'all'); return 1; } sub plugin_unregister { print "Plugin removed\n"; return 1; } sub EXAMPLE_ping { my ($self, $pluggable) = splice @_, 0, 2; my $text = ${ $_[0] }; print "Plugin got '$text'\n"; return PLUGIN_EAT_NONE; } } use strict; use warnings; use POE; my $pluggable = SimplePoCo->spawn( alias => 'pluggable', time => 1, ); POE::Session->create( package_states => [ main => [qw(_start simplepoco_registered simplepoco_ping)], ], ); $poe_kernel->run(); sub _start { my $kernel = $_[KERNEL]; $kernel->post(pluggable => 'register'); return; } sub simplepoco_registered { print "Main program registered for events\n"; my $plugin = SimplePoCo::Plugin->new(); $pluggable->plugin_add('TestPlugin', $plugin); return; } sub simplepoco_ping { my ($heap, $text) = @_[HEAP, ARG0]; print "Main program got '$text'\n"; $heap->{got_ping}++; $pluggable->shutdown() if $heap->{got_ping} == 3; return; } DESCRIPTION Object::Pluggable is a base class for creating plugin enabled objects. It is a generic port of POE::Component::IRC's plugin system. If your object dispatches events to listeners, then Object::Pluggable may be a good fit for you. Basic use would involve subclassing Object::Pluggable, then overriding "_pluggable_event()" and inserting "_pluggable_process()" wherever you dispatch events from. Users of your object can then load plugins using the plugin methods provided to handle events generated by the object. You may also use plugin style handlers within your object as "_pluggable_process()" will attempt to process any events with local method calls first. The return value of these handlers has the same significance as the return value of 'normal' plugin handlers. PRIVATE METHODS Subclassing Object::Pluggable gives your object the following 'private' methods: "_pluggable_init" This should be called on your object after initialisation, but before you want to start processing plugins. It accepts a number of argument/value pairs: 'types', an arrayref of the types of events that your poco will support, OR a hashref with the event types as keys and their abbrevations (used as plugin event method prefixes) as values. This argument is mandatory. 'prefix', the prefix for your events (default: 'pluggable_'); 'reg_prefix', the prefix for the register()/unregister() plugin methods (default: 'plugin_'); 'debug', a boolean, if true, will cause a warning to be printed every time a plugin call fails. Notes: 'prefix' should probably end with a '_'. The types specify the prefixes for plugin handlers. You can specify as many different types as you require. "_pluggable_destroy" This should be called from any shutdown handler that your poco has. The method unloads any loaded plugins. "_pluggable_process" This should be called before events are dispatched to interested sessions. This gives pluggable a chance to discard events if requested to by a plugin. The first argument is a type, as specified to "_pluggable_init()". sub _dispatch { my ($self, $event, $type, @args) = @_; # stuff my $type = ... return 1 if $self->_pluggable_process($type, $event, \@args)) == PLUGIN_EAT_ALL; # dispatch event to interested sessions. } A reference to the argument array is passed. This allows the plugin system to mangle the arguments or even add new ones. "_pluggable_event" This method should be overridden in your class so that pipeline can dispatch events through your event dispatcher. Pipeline sends a prefixed 'plugin_add' and 'plugin_del' event whenever plugins are added or removed, respectively. A prefixed 'plugin_error' event will be sent if a plugin a) raises an exception, b) fails to return a true value from its register/unregister methods, or c) fails to return a valid EAT constant from a handler. sub _pluggable_event { my $self = shift; $poe_kernel->post($self->{session_id}, '__send_event', @_); } There is an example of this in the SYNOPSIS. PUBLIC METHODS Subclassing Object::Pluggable gives your object the following public methods: "pipeline" Returns the Object::Pluggable::Pipeline object. "plugin_add" Accepts two arguments: The alias for the plugin The actual plugin object Any number of extra arguments The alias is there for the user to refer to it, as it is possible to have multiple plugins of the same kind active in one Object::Pluggable object. This method goes through the pipeline's "push()" method, which will call "$plugin->plugin_register($pluggable, @args)". Returns the number of plugins now in the pipeline if plugin was initialized, "undef"/an empty list if not. "plugin_del" Accepts the following arguments: The alias for the plugin or the plugin object itself Any number of extra arguments This method goes through the pipeline's "remove()" method, which will call "$plugin->plugin_unregister($pluggable, @args)". Returns the plugin object if the plugin was removed, "undef"/an empty list if not. "plugin_get" Accepts the following arguments: The alias for the plugin This method goes through the pipeline's "get()" method. Returns the plugin object if it was found, "undef"/an empty list if not. "plugin_list" Takes no arguments. Returns a hashref of plugin objects, keyed on alias, or an empty list if there are no plugins loaded. "plugin_order" Takes no arguments. Returns an arrayref of plugin objects, in the order which they are encountered in the pipeline. "plugin_register" Accepts the following arguments: The plugin object The type of the hook (the hook types are specified with _pluggable_init()'s 'types') The event name[s] to watch The event names can be as many as possible, or an arrayref. They correspond to the prefixed events and naturally, arbitrary events too. You do not need to supply events with the prefix in front of them, just the names. It is possible to register for all events by specifying 'all' as an event. Returns 1 if everything checked out fine, "undef"/an empty list if something is seriously wrong. "plugin_unregister" Accepts the following arguments: The plugin object The type of the hook (the hook types are specified with _pluggable_init()'s 'types') The event name[s] to unwatch The event names can be as many as possible, or an arrayref. They correspond to the prefixed events and naturally, arbitrary events too. You do not need to supply events with the prefix in front of them, just the names. It is possible to register for all events by specifying 'all' as an event. Returns 1 if all the event name[s] was unregistered, undef if some was not found. PLUGINS The basic anatomy of a pluggable plugin is: # Import the constants, of course you could provide your own # constants as long as they map correctly. use Object::Pluggable::Constants qw( :ALL ); # Our constructor sub new { ... } # Required entry point for pluggable plugins sub plugin_register { my($self, $pluggable) = @_; # Register events we are interested in $pluggable->plugin_register($self, 'SERVER', qw(something whatever)); # Return success return 1; } # Required exit point for pluggable sub plugin_unregister { my($self, $pluggable) = @_; # Pluggable will automatically unregister events for the plugin # Do some cleanup... # Return success return 1; } sub _default { my($self, $pluggable, $event) = splice @_, 0, 3; print "Default called for $event\n"; # Return an exit code return PLUGIN_EAT_NONE; } As shown in the example above, a plugin's "_default" subroutine (if present) is called if the plugin receives an event for which it has no handler. The special exit code CONSTANTS are documented in Object::Pluggable::Constants. You could provide your own as long as the values match up, though. TODO Better documentation >:] AUTHOR Chris 'BinGOs' Williams LICENSE Copyright "(c)" Chris Williams, Apocalypse, Hinrik Örn Sigurðsson and Jeff Pinyan This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details. KUDOS APOCAL for writing the original POE::Component::IRC plugin system. japhy for writing POE::Component::IRC::Pipeline which improved on it. All the happy chappies who have contributed to POE::Component::IRC over the years (yes, it has been years) refining and tweaking the plugin system. The initial idea was heavily borrowed from X-Chat, BIG thanks go out to the genius that came up with the EAT_* system :) SEE ALSO POE::Component::IRC Object::Pluggable::Pipeline Both POE::Component::Client::NNTP and POE::Component::Server::NNTP use this module as a base, examination of their source may yield further understanding. Changes000644001750001750 700211453754351 16070 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29Object::Pluggable ========================= 1.29 Sat Oct 9 02:52:22 GMT 2010 - I didn't actually set the version (1.36) for Pod::Parser. Fixed. 1.28 Sat Oct 2 12:06:47 GMT 2010 - Require Pod::Parser 1.36 to avoid test failures due to =encoding utf8 1.27 Tue Sep 28 19:31:45 2010 +0000 - Allow arguments to be passed to plugins' register/unregister methods - Localize $@ before we eval - Let subclasses and plugins add new event arguments in their handlers - Remove the POE dependency - Fixed a warning when a subclass plugin method returns undef - Change the name from POE::Component::Pluggable to Object::Pluggable - Migrate distribution to Dist::Zilla 1.26 Fri Jun 25 18:35:15 BST 2010 - Document the 'debug' parameter - Croak if the user does not supply the 'types' parameter - Fix problems with SYNOPSIS and show example plugin usage - Don't warn inside plugin_del - Don't complain about invalid eat constants when debug mode is off - Add irc_plugin_error event ( All the above by Hinrik ). 1.24 Tue Aug 18 09:17:59 BST 2009 - Applied patch from Jonathan Steinert to fix RT #48788 1.22 Thu Jul 23 14:12:05 BST 2009 - Added constant 1.17 as a prereq. Versions prior to 1.03 did not support the use constant { }; construct. 1.20 Wed Apr 29 09:27:08 BST 2009 - Removed the crufty checks in Makefile.PL for 'weaken' support and required Task::Weaken instead. - Fixed some warnings when plugin return undef. 1.18 Sat Apr 11 10:05:02 BST 2009 - Tidied up all the code. Removed hard tabs and made code more readable some places. (Hinrik) - Complain when plugin register/unregister subroutines don't return a true value (Hinrik) 1.16 Wed Mar 4 23:07:47 GMT 2009 - Remove extraneous newline from some debug messages (Hinrik) - Give a helpful warning when a plugin handler does not return a valid EAT constant (Hinrik) 1.14 Mon Jan 26 12:25:26 GMT 2009 - We were not processing '_default' in $self. Fixed. 1.12 Thu Jan 22 10:29:10 GMT 2009 - Fixed circular reference problem with ::Pipeline reported with hints on how to fix by Jonathan Steinert - Some Makefile.PL magic to make sure that we have Scalar::Util::weaken 1.10 Thu Jun 26 19:19:37 BST 2008 - Report errors if register/unregister calls fail (Hinrik) 1.08 Sat Jun 14 08:41:53 BST 2008 - Lower-case the event name before processing it (Hinrik) 1.06 Tue May 27 19:32:46 BST 2008 - Allow changing the _register()/_unregister() prefix (Hinrik) - Allow abbreviating event prefixes in method names (Hinrik) - Improved error handling somewhat (Hinrik) - Some improvements in documentation (Hinrik) 1.04 Tue May 6 11:55:54 BST 2008 - Removed kwalitee test and added license information 1.02 Tue Feb 26 13:12:36 GMT 2008 - Some Kwalitee fixes and doc tweaks. 1.00 Thu Nov 1 07:12:04 GMT 2007 - Updated Module::Install to 0.68 0.06 Wed Jul 25 12:19:27 BST 2007 - Fixed abstract_from and build_requires in Makefile.PL 0.05 Fri Feb 16 16:27:56 GMT 2007 - Added kwalitee test 0.04 Wed Dec 06 07:37:37 GMT 2006 - strict was missing from pluggable. Doh. Kwalitee failure. 0.03 Mon Dec 04 19:01:34 GMT 2006 - Classic school-boy error. Poco event handlers were clobbering all events. 0.02 Mon Dec 04 18:27:05 GMT 2006 - The return value of component plugin event handlers now affect subsequent processing of events. 0.01 Wed Nov 29 12:01:34 GMT 2006 - Initial CPAN release. LICENSE000644001750001750 4363511453754351 15636 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29This software is copyright (c) 2010 by Chris Williams, Hinrik Örn Sigurðsson. This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself. Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2010 by Chris Williams, Hinrik Örn Sigurðsson. This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA. Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2010 by Chris Williams, Hinrik Örn Sigurðsson. This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End dist.ini000644001750001750 122311453754351 16240 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29name = Object-Pluggable author = Chris Williams author = Hinrik Örn Sigurðsson copyright_holder = Chris Williams, Hinrik Örn Sigurðsson license = Perl_5 [@AVAR] dist = Object-Pluggable authority = cpan:HINRIK bugtracker = rt use_CompileTests = 0 nextrelease_format = %-5v %{ccc MMM d HH:mm:ss V YYYY}d github_user = hinrik git_tag_message = CPAN release %v no_AutoPrereq = 1 [Prereqs / Runtime] perl = 5.006 constant = 1.17 Task::Weaken = 0 [Prereqs / BuildRequires] Test::More = 0 Pod::Parser = 1.36 META.yml000644001750001750 161211453754351 16047 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29--- abstract: 'A base class for creating plugin-enabled objects' author: - 'Chris Williams ' - 'Hinrik Örn Sigurðsson ' build_requires: Pod::Parser: 1.36 Test::More: 0 configure_requires: ExtUtils::MakeMaker: 6.31 dynamic_config: 0 generated_by: 'Dist::Zilla version 4.102341, CPAN::Meta::Converter version 2.101670' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Object-Pluggable no_index: directory: - t - utils - examples requires: Task::Weaken: 0 constant: 1.17 perl: 5.006 resources: bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Object-Pluggable homepage: http://search.cpan.org/dist/Object-Pluggable/ license: http://dev.perl.org/licenses/ repository: git://github.com/hinrik/object-pluggable.git version: 1.29 x_authority: cpan:HINRIK MANIFEST000644001750001750 43011453754351 15704 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29Changes LICENSE MANIFEST MANIFEST.SKIP META.json META.yml Makefile.PL README dist.ini examples/synopsis.pl lib/Object/Pluggable.pm lib/Object/Pluggable/Constants.pm lib/Object/Pluggable/Pipeline.pm t/00_compile.t t/01_basic.t t/99_pod.t t/99_pod_coverage.t t/release-pod-syntax.t META.json000644001750001750 315611453754351 16224 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29{ "abstract" : "A base class for creating plugin-enabled objects", "author" : [ "Chris Williams ", "Hinrik \u00c3\u0096rn Sigur\u00c3\u00b0sson " ], "dynamic_config" : 0, "generated_by" : "Dist::Zilla version 4.102341, CPAN::Meta::Converter version 2.101670", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Object-Pluggable", "no_index" : { "directory" : [ "t", "utils", "examples" ] }, "prereqs" : { "build" : { "requires" : { "Pod::Parser" : "1.36", "Test::More" : 0 } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "6.31" } }, "runtime" : { "requires" : { "Task::Weaken" : 0, "constant" : "1.17", "perl" : "5.006" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Object-Pluggable@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Object-Pluggable" }, "homepage" : "http://search.cpan.org/dist/Object-Pluggable/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://github.com/hinrik/object-pluggable.git", "web" : "http://github.com/hinrik/object-pluggable" } }, "version" : "1.29", "x_authority" : "cpan:HINRIK" } t000755001750001750 011453754351 14702 5ustar00hinrikhinrik000000000000Object-Pluggable-1.2999_pod.t000644001750001750 20111453754351 16302 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/tuse Test::More; eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; all_pod_files_ok(); Makefile.PL000644001750001750 222511453754351 16551 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29 use strict; use warnings; BEGIN { require 5.006; } use ExtUtils::MakeMaker 6.31; my %WriteMakefileArgs = ( 'ABSTRACT' => 'A base class for creating plugin-enabled objects', 'AUTHOR' => 'Chris Williams , Hinrik Örn Sigurðsson ', 'BUILD_REQUIRES' => { 'Pod::Parser' => '1.36', 'Test::More' => '0' }, 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => '6.31' }, 'DISTNAME' => 'Object-Pluggable', 'EXE_FILES' => [], 'LICENSE' => 'perl', 'NAME' => 'Object::Pluggable', 'PREREQ_PM' => { 'Task::Weaken' => '0', 'constant' => '1.17' }, 'VERSION' => '1.29', 'test' => { 'TESTS' => 't/*.t' } ); unless ( eval { ExtUtils::MakeMaker->VERSION(6.56) } ) { my $br = delete $WriteMakefileArgs{BUILD_REQUIRES}; my $pp = $WriteMakefileArgs{PREREQ_PM}; for my $mod ( keys %$br ) { if ( exists $pp->{$mod} ) { $pp->{$mod} = $br->{$mod} if $br->{$mod} > $pp->{$mod}; } else { $pp->{$mod} = $br->{$mod}; } } } delete $WriteMakefileArgs{CONFIGURE_REQUIRES} unless eval { ExtUtils::MakeMaker->VERSION(6.52) }; WriteMakefile(%WriteMakefileArgs); 01_basic.t000644001750001750 411711453754351 16612 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/tuse strict; use warnings; use Test::More tests => 7; { package TestSubClass; use strict; use warnings; use base qw(Object::Pluggable); use Test::More; use Object::Pluggable::Constants qw(:ALL); sub spawn { my $package = shift; my $self = bless { }, $package; $self->_pluggable_init( types => ['SERVER'], ); return $self; } sub shutdown { my ($self) = @_; $self->_pluggable_destroy(); return; } sub send_event { my ($self, $event, @args) = @_; $self->_pluggable_process('SERVER', $event, \@args); return; } sub run { my ($self) = @_; $self->send_event('test'); $self->send_event('noret'); return; } sub _pluggable_event { my ($self, @args) = @_; $self->send_event(@args); return; } sub SERVER_test { pass(__PACKAGE__ . ' test event'); return PLUGIN_EAT_NONE; } sub SERVER_noret { pass(__PACKAGE__ . ' noret event'); return; } } { package TestPlugin; use strict; use warnings; use Test::More; use Object::Pluggable::Constants qw(:ALL); sub new { my $package = shift; return bless { @_ }, $package; } sub plugin_register { my ($self,$subclass) = splice @_, 0, 2; pass(__PACKAGE__ . " Plugin Register"); $subclass->plugin_register( $self, 'SERVER', qw(all) ); return 1; } sub plugin_unregister { pass(__PACKAGE__ . " Plugin Unregister"); return 1; } sub SERVER_test { my ($self,$irc) = splice @_, 0, 2; pass(__PACKAGE__ . ' test event'); return PLUGIN_EAT_NONE; } sub SERVER_noret { my ($self,$irc) = splice @_, 0, 2; pass(__PACKAGE__ . ' noret event'); return; } } use strict; use warnings; my $pluggable = TestSubClass->spawn(); isa_ok($pluggable, 'Object::Pluggable' ); $pluggable->plugin_add( 'TestPlugin', TestPlugin->new() ); $pluggable->run(); $pluggable->shutdown(); MANIFEST.SKIP000644001750001750 10711453754351 16452 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29^Acme-CPANAuthors-Icelandic- ^cover_db/ ^utils/developer/ ^README.pod$ 00_compile.t000644001750001750 36011453754351 17134 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/tuse strict; use warnings; use Test::More tests => 3; use_ok('Object::Pluggable::Constants'); use_ok('Object::Pluggable::Pipeline'); use_ok('Object::Pluggable'); diag( "Testing Object::Pluggable $Object::Pluggable::VERSION, Perl $], $^X" ); 99_pod_coverage.t000644001750001750 24111453754351 20161 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/tuse Test::More; eval "use Test::Pod::Coverage 1.00"; plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@; all_pod_coverage_ok(); examples000755001750001750 011453754351 16255 5ustar00hinrikhinrik000000000000Object-Pluggable-1.29synopsis.pl000644001750001750 1064011453754351 20661 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/examples# A simple POE Component that sends ping events to registered sessions # and plugins every second. { package SimplePoCo; use strict; use warnings; use base qw(Object::Pluggable); use POE; use Object::Pluggable::Constants qw(:ALL); sub spawn { my ($package, %opts) = @_; my $self = bless \%opts, $package; $self->_pluggable_init( prefix => 'simplepoco_', types => [qw(EXAMPLE)], debug => 1, ); POE::Session->create( object_states => [ $self => { shutdown => '_shutdown' }, $self => [qw(_send_ping _start register unregister __send_event)], ], ); return $self; } sub shutdown { my ($self) = @_; $poe_kernel->post($self->{session_id}, 'shutdown'); } sub _pluggable_event { my ($self) = @_; $poe_kernel->post($self->{session_id}, '__send_event', @_); } sub _start { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->{session_id} = $_[SESSION]->ID(); if ($self->{alias}) { $kernel->alias_set($self->{alias}); } else { $kernel->refcount_increment($self->{session_id}, __PACKAGE__); } $kernel->delay(_send_ping => $self->{time} || 300); return; } sub _shutdown { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->_pluggable_destroy(); $kernel->alarm_remove_all(); $kernel->alias_remove($_) for $kernel->alias_list(); $kernel->refcount_decrement($self->{session_id}, __PACKAGE__) if !$self->{alias}; $kernel->refcount_decrement($_, __PACKAGE__) for keys %{ $self->{sessions} }; return; } sub register { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); $self->{sessions}->{$sender_id}++; if ($self->{sessions}->{$sender_id} == 1) { $kernel->refcount_increment($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_registered', $sender_id); } return; } sub unregister { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); my $record = delete $self->{sessions}->{$sender_id}; if ($record) { $kernel->refcount_decrement($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_unregistered', $sender_id); } return; } sub __send_event { my ($kernel, $self, $event, @args) = @_[KERNEL, OBJECT, ARG0..$#_]; return 1 if $self->_pluggable_process(EXAMPLE => $event, \(@args)) == PLUGIN_EAT_ALL; $kernel->post($_, $event, @args) for keys %{ $self->{sessions} }; } sub _send_ping { my ($kernel, $self) = @_[KERNEL, OBJECT]; $kernel->yield(__send_event => 'simplepoco_ping', 'Wake up sleepy'); $kernel->delay(_send_ping => $self->{time} || 1); return; } } { package SimplePoCo::Plugin; use strict; use warnings; use Object::Pluggable::Constants qw(:ALL); sub new { my $package = shift; return bless { @_ }, $package; } sub plugin_register { my ($self, $pluggable) = splice @_, 0, 2; print "Plugin added\n"; $pluggable->plugin_register($self, 'EXAMPLE', 'all'); return 1; } sub plugin_unregister { print "Plugin removed\n"; return 1; } sub EXAMPLE_ping { my ($self, $pluggable) = splice @_, 0, 2; my $text = ${ $_[0] }; print "Plugin got '$text'\n"; return PLUGIN_EAT_NONE; } } use strict; use warnings; use POE; my $pluggable = SimplePoCo->spawn( alias => 'pluggable', time => 1, ); POE::Session->create( package_states => [ main => [qw(_start simplepoco_registered simplepoco_ping)], ], ); $poe_kernel->run(); sub _start { my $kernel = $_[KERNEL]; $kernel->post(pluggable => 'register'); return; } sub simplepoco_registered { print "Main program registered for events\n"; my $plugin = SimplePoCo::Plugin->new(); $pluggable->plugin_add('TestPlugin', $plugin); return; } sub simplepoco_ping { my ($heap, $text) = @_[HEAP, ARG0]; print "Main program got '$text'\n"; $heap->{got_ping}++; $pluggable->shutdown() if $heap->{got_ping} == 3; return; } release-pod-syntax.t000644001750001750 45011453754351 20731 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/t#!perl BEGIN { unless ($ENV{RELEASE_TESTING}) { require Test::More; Test::More::plan(skip_all => 'these tests are for release candidate testing'); } } use Test::More; eval "use Test::Pod 1.41"; plan skip_all => "Test::Pod 1.41 required for testing POD" if $@; all_pod_files_ok(); Object000755001750001750 011453754351 16413 5ustar00hinrikhinrik000000000000Object-Pluggable-1.29/libPluggable.pm000644001750001750 5001111453754351 21027 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/lib/Objectpackage Object::Pluggable; BEGIN { $Object::Pluggable::AUTHORITY = 'cpan:HINRIK'; } BEGIN { $Object::Pluggable::VERSION = '1.29'; } use strict; use warnings; use Carp; use Object::Pluggable::Pipeline; use Object::Pluggable::Constants qw(:ALL); sub _pluggable_init { my ($self, %opts) = @_; $self->{'_pluggable_' . lc $_} = delete $opts{$_} for keys %opts; $self->{_pluggable_reg_prefix} = 'plugin_' if !$self->{_pluggable_reg_prefix}; $self->{_pluggable_prefix} = 'pluggable_' if !$self->{_pluggable_prefix}; if (ref $self->{_pluggable_types} eq 'ARRAY') { $self->{_pluggable_types} = { map { $_ => $_ } @{ $self->{_pluggable_types} } }; } elsif (ref $self->{_pluggable_types} ne 'HASH') { croak "Argument 'types' must be supplied"; } return 1; } sub _pluggable_destroy { my ($self) = @_; $self->plugin_del( $_ ) for keys %{ $self->plugin_list() }; return; } sub _pluggable_event { return; } sub _pluggable_process { my ($self, $type, $event, $args) = @_; if (!defined $type || !defined $event) { carp 'Please supply an event type and name!'; return; } $event = lc $event; my $pipeline = $self->pipeline; my $prefix = $self->{_pluggable_prefix}; $event =~ s/^\Q$prefix\E//; my $sub = join '_', $self->{_pluggable_types}{$type}, $event; my $return = PLUGIN_EAT_NONE; my $self_ret = $return; my @extra_args; local $@; if ($self->can($sub)) { eval { $self_ret = $self->$sub($self, \(@$args), \@extra_args ) }; $self->_handle_error($self, $sub, $self_ret); } elsif ( $self->can('_default') ) { eval { $self_ret = $self->_default($self, $sub, \(@$args), \@extra_args) }; $self->_handle_error($self, '_default', $self_ret); } $self_ret = PLUGIN_EAT_NONE unless defined $self_ret; return $return if $self_ret == PLUGIN_EAT_PLUGIN; $return = PLUGIN_EAT_ALL if $self_ret == PLUGIN_EAT_CLIENT; return PLUGIN_EAT_ALL if $self_ret == PLUGIN_EAT_ALL; if (@extra_args) { push @$args, @extra_args; @extra_args = (); } for my $plugin (@{ $pipeline->{PIPELINE} }) { if ($self eq $plugin || !$pipeline->{HANDLES}{$plugin}{$type}{$event} && !$pipeline->{HANDLES}{$plugin}{$type}{all}) { next; } my $ret = PLUGIN_EAT_NONE; my $alias = ($pipeline->get($plugin))[1]; if ($plugin->can($sub)) { eval { $ret = $plugin->$sub($self, \(@$args), \@extra_args) }; $self->_handle_error($plugin, $sub, $ret, $alias); } elsif ( $plugin->can('_default') ) { eval { $ret = $plugin->_default($self, $sub, \(@$args), \@extra_args) }; $self->_handle_error($plugin, '_default', $ret, $alias); } $ret = PLUGIN_EAT_NONE unless defined $ret; return $return if $ret == PLUGIN_EAT_PLUGIN; $return = PLUGIN_EAT_ALL if $ret == PLUGIN_EAT_CLIENT; return PLUGIN_EAT_ALL if $ret == PLUGIN_EAT_ALL; if (@extra_args) { push @$args, @extra_args; @extra_args = (); } } return $return; } sub _handle_error { my ($self, $object, $sub, $return, $source) = @_; $source = defined $source ? "plugin '$source'" : 'self'; if ($@) { chomp $@; my $error = "$sub call on $source failed: $@"; warn "$error\n" if $self->{_pluggable_debug}; $self->_pluggable_event( "$self->{_pluggable_prefix}plugin_error", $error, ($object == $self ? ($object, $source) : ()), ); } elsif ( !defined $return || ($return != PLUGIN_EAT_NONE && $return != PLUGIN_EAT_PLUGIN && $return != PLUGIN_EAT_CLIENT && $return != PLUGIN_EAT_ALL) ) { my $error = "$sub call on $source did not return a valid EAT constant"; warn "$error\n" if $self->{_pluggable_debug}; $self->_pluggable_event( "$self->{_pluggable_prefix}plugin_error", $error, ($object == $self ? ($object, $source) : ()), ); } return; } # accesses the plugin pipeline sub pipeline { my ($self) = @_; local $@; eval { $self->{_PLUGINS}->isa('Object::Pluggble::Pipeline') }; $self->{_PLUGINS} = Object::Pluggable::Pipeline->new($self) if $@; return $self->{_PLUGINS}; } # Adds a new plugin object sub plugin_add { my ($self, $name, $plugin, @args) = @_; if (!defined $name || !defined $plugin) { carp 'Please supply a name and the plugin object to be added!'; return; } return $self->pipeline->push($name, $plugin, @args); } # Removes a plugin object sub plugin_del { my ($self, $name, @args) = @_; if (!defined $name) { carp 'Please supply a name/object for the plugin to be removed!'; return; } my $return = scalar $self->pipeline->remove($name, @args); return $return; } # Gets the plugin object sub plugin_get { my ($self, $name) = @_; if (!defined $name) { carp 'Please supply a name/object for the plugin to be removed!'; return; } return scalar $self->pipeline->get($name); } # Lists loaded plugins sub plugin_list { my ($self) = @_; my $pipeline = $self->pipeline; my %return = map {$pipeline->{PLUGS}{$_} => $_} @{ $pipeline->{PIPELINE} }; return \%return; } # Lists loaded plugins in order! sub plugin_order { my ($self) = @_; return $self->pipeline->{PIPELINE}; } sub plugin_register { my ($self, $plugin, $type, @events) = @_; my $pipeline = $self->pipeline; if (!grep { $_ eq $type } keys %{ $self->{_pluggable_types} }) { carp "The event type '$type' is not supported!"; return; } if (!defined $plugin) { carp 'Please supply the plugin object to register events for!'; return; } if (!@events) { carp 'Please supply at least one event to register!'; return; } for my $ev (@events) { if (ref $ev and ref $ev eq 'ARRAY') { $pipeline->{HANDLES}{$plugin}{$type}{lc $_} = 1 for @$ev; } else { $pipeline->{HANDLES}{$plugin}{$type}{lc $ev} = 1; } } return 1; } sub plugin_unregister { my ($self, $plugin, $type, @events) = @_; my $pipeline = $self->pipeline; if (!grep { $_ eq $type } keys %{ $self->{_pluggable_types} }) { carp "The event type '$type' is not supported!"; return; } if (!defined $plugin) { carp 'Please supply the plugin object to register!'; return; } if (!@events) { carp 'Please supply at least one event to unregister!'; return; } for my $ev (@events) { if (ref $ev and ref $ev eq "ARRAY") { for my $e (map { lc } @$ev) { if (!delete $pipeline->{HANDLES}{$plugin}{$type}{$e}) { carp "The event '$e' does not exist!"; next; } } } else { $ev = lc $ev; if (!delete $pipeline->{HANDLES}{$plugin}{$type}{$ev}) { carp "The event '$ev' does not exist!"; next; } } } return 1; } 1; __END__ =encoding utf8 =head1 NAME Object::Pluggable - A base class for creating plugin-enabled objects =head1 SYNOPSIS # A simple POE Component that sends ping events to registered sessions # and plugins every second. { package SimplePoCo; use strict; use warnings; use base qw(Object::Pluggable); use POE; use Object::Pluggable::Constants qw(:ALL); sub spawn { my ($package, %opts) = @_; my $self = bless \%opts, $package; $self->_pluggable_init( prefix => 'simplepoco_', types => [qw(EXAMPLE)], debug => 1, ); POE::Session->create( object_states => [ $self => { shutdown => '_shutdown' }, $self => [qw(_send_ping _start register unregister __send_event)], ], ); return $self; } sub shutdown { my ($self) = @_; $poe_kernel->post($self->{session_id}, 'shutdown'); } sub _pluggable_event { my ($self) = @_; $poe_kernel->post($self->{session_id}, '__send_event', @_); } sub _start { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->{session_id} = $_[SESSION]->ID(); if ($self->{alias}) { $kernel->alias_set($self->{alias}); } else { $kernel->refcount_increment($self->{session_id}, __PACKAGE__); } $kernel->delay(_send_ping => $self->{time} || 300); return; } sub _shutdown { my ($kernel, $self) = @_[KERNEL, OBJECT]; $self->_pluggable_destroy(); $kernel->alarm_remove_all(); $kernel->alias_remove($_) for $kernel->alias_list(); $kernel->refcount_decrement($self->{session_id}, __PACKAGE__) if !$self->{alias}; $kernel->refcount_decrement($_, __PACKAGE__) for keys %{ $self->{sessions} }; return; } sub register { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); $self->{sessions}->{$sender_id}++; if ($self->{sessions}->{$sender_id} == 1) { $kernel->refcount_increment($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_registered', $sender_id); } return; } sub unregister { my ($kernel, $sender, $self) = @_[KERNEL, SENDER, OBJECT]; my $sender_id = $sender->ID(); my $record = delete $self->{sessions}->{$sender_id}; if ($record) { $kernel->refcount_decrement($sender_id, __PACKAGE__); $kernel->yield(__send_event => 'simplepoco_unregistered', $sender_id); } return; } sub __send_event { my ($kernel, $self, $event, @args) = @_[KERNEL, OBJECT, ARG0..$#_]; return 1 if $self->_pluggable_process(EXAMPLE => $event, \@args) == PLUGIN_EAT_ALL; $kernel->post($_, $event, @args) for keys %{ $self->{sessions} }; } sub _send_ping { my ($kernel, $self) = @_[KERNEL, OBJECT]; $kernel->yield(__send_event => 'simplepoco_ping', 'Wake up sleepy'); $kernel->delay(_send_ping => $self->{time} || 1); return; } } { package SimplePoCo::Plugin; use strict; use warnings; use Object::Pluggable::Constants qw(:ALL); sub new { my $package = shift; return bless { @_ }, $package; } sub plugin_register { my ($self, $pluggable) = splice @_, 0, 2; print "Plugin added\n"; $pluggable->plugin_register($self, 'EXAMPLE', 'all'); return 1; } sub plugin_unregister { print "Plugin removed\n"; return 1; } sub EXAMPLE_ping { my ($self, $pluggable) = splice @_, 0, 2; my $text = ${ $_[0] }; print "Plugin got '$text'\n"; return PLUGIN_EAT_NONE; } } use strict; use warnings; use POE; my $pluggable = SimplePoCo->spawn( alias => 'pluggable', time => 1, ); POE::Session->create( package_states => [ main => [qw(_start simplepoco_registered simplepoco_ping)], ], ); $poe_kernel->run(); sub _start { my $kernel = $_[KERNEL]; $kernel->post(pluggable => 'register'); return; } sub simplepoco_registered { print "Main program registered for events\n"; my $plugin = SimplePoCo::Plugin->new(); $pluggable->plugin_add('TestPlugin', $plugin); return; } sub simplepoco_ping { my ($heap, $text) = @_[HEAP, ARG0]; print "Main program got '$text'\n"; $heap->{got_ping}++; $pluggable->shutdown() if $heap->{got_ping} == 3; return; } =head1 DESCRIPTION Object::Pluggable is a base class for creating plugin enabled objects. It is a generic port of L's plugin system. If your object dispatches events to listeners, then Object::Pluggable may be a good fit for you. Basic use would involve subclassing Object::Pluggable, then overriding C<_pluggable_event()> and inserting C<_pluggable_process()> wherever you dispatch events from. Users of your object can then load plugins using the plugin methods provided to handle events generated by the object. You may also use plugin style handlers within your object as C<_pluggable_process()> will attempt to process any events with local method calls first. The return value of these handlers has the same significance as the return value of 'normal' plugin handlers. =head1 PRIVATE METHODS Subclassing Object::Pluggable gives your object the following 'private' methods: =head2 C<_pluggable_init> This should be called on your object after initialisation, but before you want to start processing plugins. It accepts a number of argument/value pairs: 'types', an arrayref of the types of events that your poco will support, OR a hashref with the event types as keys and their abbrevations (used as plugin event method prefixes) as values. This argument is mandatory. 'prefix', the prefix for your events (default: 'pluggable_'); 'reg_prefix', the prefix for the register()/unregister() plugin methods (default: 'plugin_'); 'debug', a boolean, if true, will cause a warning to be printed every time a plugin call fails. Notes: 'prefix' should probably end with a '_'. The types specify the prefixes for plugin handlers. You can specify as many different types as you require. =head2 C<_pluggable_destroy> This should be called from any shutdown handler that your poco has. The method unloads any loaded plugins. =head2 C<_pluggable_process> This should be called before events are dispatched to interested sessions. This gives pluggable a chance to discard events if requested to by a plugin. The first argument is a type, as specified to C<_pluggable_init()>. sub _dispatch { my ($self, $event, $type, @args) = @_; # stuff my $type = ... return 1 if $self->_pluggable_process($type, $event, \@args)) == PLUGIN_EAT_ALL; # dispatch event to interested sessions. } A reference to the argument array is passed. This allows the plugin system to mangle the arguments or even add new ones. =head2 C<_pluggable_event> This method should be overridden in your class so that pipeline can dispatch events through your event dispatcher. Pipeline sends a prefixed 'plugin_add' and 'plugin_del' event whenever plugins are added or removed, respectively. A prefixed 'plugin_error' event will be sent if a plugin a) raises an exception, b) fails to return a true value from its register/unregister methods, or c) fails to return a valid EAT constant from a handler. sub _pluggable_event { my $self = shift; $poe_kernel->post($self->{session_id}, '__send_event', @_); } There is an example of this in the SYNOPSIS. =head1 PUBLIC METHODS Subclassing Object::Pluggable gives your object the following public methods: =head2 C Returns the L object. =head2 C Accepts two arguments: The alias for the plugin The actual plugin object Any number of extra arguments The alias is there for the user to refer to it, as it is possible to have multiple plugins of the same kind active in one Object::Pluggable object. This method goes through the pipeline's C method, which will call C<< $plugin->plugin_register($pluggable, @args) >>. Returns the number of plugins now in the pipeline if plugin was initialized, C/an empty list if not. =head2 C Accepts the following arguments: The alias for the plugin or the plugin object itself Any number of extra arguments This method goes through the pipeline's C method, which will call C<< $plugin->plugin_unregister($pluggable, @args) >>. Returns the plugin object if the plugin was removed, C/an empty list if not. =head2 C Accepts the following arguments: The alias for the plugin This method goes through the pipeline's C method. Returns the plugin object if it was found, C/an empty list if not. =head2 C Takes no arguments. Returns a hashref of plugin objects, keyed on alias, or an empty list if there are no plugins loaded. =head2 C Takes no arguments. Returns an arrayref of plugin objects, in the order which they are encountered in the pipeline. =head2 C Accepts the following arguments: The plugin object The type of the hook (the hook types are specified with _pluggable_init()'s 'types') The event name[s] to watch The event names can be as many as possible, or an arrayref. They correspond to the prefixed events and naturally, arbitrary events too. You do not need to supply events with the prefix in front of them, just the names. It is possible to register for all events by specifying 'all' as an event. Returns 1 if everything checked out fine, C/an empty list if something is seriously wrong. =head2 C Accepts the following arguments: The plugin object The type of the hook (the hook types are specified with _pluggable_init()'s 'types') The event name[s] to unwatch The event names can be as many as possible, or an arrayref. They correspond to the prefixed events and naturally, arbitrary events too. You do not need to supply events with the prefix in front of them, just the names. It is possible to register for all events by specifying 'all' as an event. Returns 1 if all the event name[s] was unregistered, undef if some was not found. =head1 PLUGINS The basic anatomy of a pluggable plugin is: # Import the constants, of course you could provide your own # constants as long as they map correctly. use Object::Pluggable::Constants qw( :ALL ); # Our constructor sub new { ... } # Required entry point for pluggable plugins sub plugin_register { my($self, $pluggable) = @_; # Register events we are interested in $pluggable->plugin_register($self, 'SERVER', qw(something whatever)); # Return success return 1; } # Required exit point for pluggable sub plugin_unregister { my($self, $pluggable) = @_; # Pluggable will automatically unregister events for the plugin # Do some cleanup... # Return success return 1; } sub _default { my($self, $pluggable, $event) = splice @_, 0, 3; print "Default called for $event\n"; # Return an exit code return PLUGIN_EAT_NONE; } As shown in the example above, a plugin's C<_default> subroutine (if present) is called if the plugin receives an event for which it has no handler. The special exit code CONSTANTS are documented in L. You could provide your own as long as the values match up, though. =head1 TODO Better documentation >:] =head1 AUTHOR Chris 'BinGOs' Williams =head1 LICENSE Copyright C<(c)> Chris Williams, Apocalypse, Hinrik Örn Sigurðsson and Jeff Pinyan This module may be used, modified, and distributed under the same terms as Perl itself. Please see the license that came with your Perl distribution for details. =head1 KUDOS APOCAL for writing the original L plugin system. japhy for writing L which improved on it. All the happy chappies who have contributed to POE::Component::IRC over the years (yes, it has been years) refining and tweaking the plugin system. The initial idea was heavily borrowed from X-Chat, BIG thanks go out to the genius that came up with the EAT_* system :) =head1 SEE ALSO L L Both L and L use this module as a base, examination of their source may yield further understanding. =cut Pluggable000755001750001750 011453754351 20315 5ustar00hinrikhinrik000000000000Object-Pluggable-1.29/lib/ObjectPipeline.pm000644001750001750 4174111453754351 22606 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/lib/Object/Pluggablepackage Object::Pluggable::Pipeline; BEGIN { $Object::Pluggable::Pipeline::AUTHORITY = 'cpan:HINRIK'; } BEGIN { $Object::Pluggable::Pipeline::VERSION = '1.29'; } use strict; use warnings; use Carp; use Scalar::Util qw(weaken); sub new { my ($package, $pluggable) = @_; my $self = bless { PLUGS => {}, PIPELINE => [], HANDLES => {}, OBJECT => $pluggable, }, $package; weaken($self->{OBJECT}); return $self; } sub push { my ($self, $alias, $plug, @register_args) = @_; if ($self->{PLUGS}{$alias}) { $@ = "Plugin named '$alias' already exists ($self->{PLUGS}{$alias})"; return; } my $return = $self->_register($alias, $plug, @register_args); return if !$return; push @{ $self->{PIPELINE} }, $plug; return scalar @{ $self->{PIPELINE} }; } sub pop { my ($self, @unregister_args) = @_; return if !@{ $self->{PIPELINE} }; my $plug = pop @{ $self->{PIPELINE} }; my $alias = $self->{PLUGS}{$plug}; $self->_unregister($alias, $plug, @unregister_args); return wantarray ? ($plug, $alias) : $plug; } sub unshift { my ($self, $alias, $plug, @register_args) = @_; if ($self->{PLUGS}{$alias}) { $@ = "Plugin named '$alias' already exists ($self->{PLUGS}{$alias}"; return; } my $return = $self->_register($alias, $plug, @register_args); return if !$return; unshift @{ $self->{PIPELINE} }, $plug; return scalar @{ $self->{PIPELINE} }; } sub shift { my ($self, @unregister_args) = @_; return if !@{ $self->{PIPELINE} }; my $plug = shift @{ $self->{PIPELINE} }; my $alias = $self->{PLUGS}{$plug}; $self->_unregister($alias, $plug, @unregister_args); return wantarray ? ($plug, $alias) : $plug; } sub replace { my ($self, $old, $new_a, $new_p, $unregister_args, $register_args) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return; } $self->_unregister( $old_a, $old_p, (ref $unregister_args eq 'ARRAY' ? @$unregister_args : () ) ); if ($self->{PLUGS}{$new_a}) { $@ = "Plugin named '$new_a' already exists ($self->{PLUGS}{$new_a}"; return; } my $return = $self->_register( $new_a, $new_p, (ref $register_args eq 'ARRAY' ? @$register_args : () ) ); return if !$return; for my $plugin (@{ $self->{PIPELINE} }) { if ($plugin == $old_p) { $plugin = $new_p; last; } } return 1; } sub remove { my ($self, $old, @unregister_args) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return; } my $i = 0; for my $plugin (@{ $self->{PIPELINE} }) { if ($plugin == $old_p) { splice(@{ $self->{PIPELINE} }, $i, 1); last; } $i++; } $self->_unregister($old_a, $old_p, @unregister_args); return wantarray ? ($old_p, $old_a) : $old_p; } sub get { my ($self, $old) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return; } return wantarray ? ($old_p, $old_a) : $old_p; } sub get_index { my ($self, $old) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return -1; } my $i = 0; for my $plugin (@{ $self->{PIPELINE} }) { return $i if $plugin == $old_p; $i++; } return -1; } sub insert_before { my ($self, $old, $new_a, $new_p, @register_args) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return; } if ($self->{PLUGS}{$new_a}) { $@ = "Plugin named '$new_a' already exists ($self->{PLUGS}{$new_a}"; return; } my $return = $self->_register($new_a, $new_p, @register_args); return if !$return; my $i = 0; for my $plugin (@{ $self->{PIPELINE} }) { if ($plugin == $old_p) { splice(@{ $self->{PIPELINE} }, $i, 0, $new_p); last; } $i++; } return 1; } sub insert_after { my ($self, $old, $new_a, $new_p, @register_args) = @_; my ($old_a, $old_p) = ref $old ? ($self->{PLUGS}{$old}, $old) : ($old, $self->{PLUGS}{$old}) ; if (!$old_p) { $@ = "Plugin '$old_a' does not exist"; return; } if ($self->{PLUGS}{$new_a}) { $@ = "Plugin named '$new_a' already exists ($self->{PLUGS}{$new_a}"; return; } my $return = $self->_register($new_a, $new_p, @register_args); return if !$return; my $i = 0; for my $plugin (@{ $self->{PIPELINE} }) { if ($plugin == $old_p) { splice(@{ $self->{PIPELINE} }, $i+1, 0, $new_p); last; } $i++; } return 1; } sub bump_up { my ($self, $old, $diff) = @_; my $idx = $self->get_index($old); return -1 if $idx < 0; my $pipeline = $self->{PIPELINE}; $diff ||= 1; my $pos = $idx - $diff; if ($pos < 0) { carp "$idx - $diff is negative, moving to head of the pipeline"; } splice(@$pipeline, $pos, 0, splice(@$pipeline, $idx, 1)); return $pos; } sub bump_down { my ($self, $old, $diff) = @_; my $idx = $self->get_index($old); return -1 if $idx < 0; my $pipeline = $self->{PIPELINE}; $diff ||= 1; my $pos = $idx + $diff; if ($pos >= @$pipeline) { carp "$idx + $diff is too high, moving to back of the pipeline"; } splice(@$pipeline, $pos, 0, splice(@$pipeline, $idx, 1)); return $pos; } sub _register { my ($self, $alias, $plug, @register_args) = @_; return if !defined $self->{OBJECT}; my $return; my $sub = "$self->{OBJECT}{_pluggable_reg_prefix}register"; local $@; eval { $return = $plug->$sub($self->{OBJECT}, @register_args) }; if ($@) { chomp $@; my $error = "$sub call on plugin '$alias' failed: $@"; $self->_handle_error($error, $plug, $alias); } elsif (!$return) { my $error = "$sub call on plugin '$alias' did not return a true value"; $self->_handle_error($error, $plug, $alias); } $self->{PLUGS}{$plug} = $alias; $self->{PLUGS}{$alias} = $plug; $self->{OBJECT}->_pluggable_event( "$self->{OBJECT}{_pluggable_prefix}plugin_add", $alias, $plug, ); return $return; } sub _unregister { my ($self, $alias, $plug, @unregister_args) = @_; return if !defined $self->{OBJECT}; my $return; my $sub = "$self->{OBJECT}{_pluggable_reg_prefix}unregister"; local $@; eval { $return = $plug->$sub($self->{OBJECT}, @unregister_args) }; if ($@) { chomp $@; my $error = "$sub call on plugin '$alias' failed: $@"; $self->_handle_error($error, $plug, $alias); } elsif (!$return) { my $error = "$sub call on plugin '$alias' did not return a true value"; $self->_handle_error($error, $plug, $alias); } delete $self->{PLUGS}{$plug}; delete $self->{PLUGS}{$alias}; delete $self->{HANDLES}{$plug}; $self->{OBJECT}->_pluggable_event( "$self->{OBJECT}{_pluggable_prefix}plugin_del", $alias, $plug, ); return $return; } sub _handle_error { my ($self, $error, $plugin, $alias) = @_; warn "$error\n" if $self->{OBJECT}{_pluggable_debug}; $self->{OBJECT}->_pluggable_event( "$self->{OBJECT}{_pluggable_prefix}plugin_error", $error, $plugin, $alias, ); return; } 1; __END__ =encoding utf8 =head1 NAME Object::Pluggable::Pipeline - The plugin pipeline for Object::Pluggable. =head1 SYNOPSIS use Object::Pluggable; use Object::Pluggable::Pipeline; use My::Plugin; my $self = Object::Pluggable->new(); # the following operations are presented in pairs # the first is the general procedure, the second is # the specific way using the pipeline directly # to install a plugin $self->plugin_add(mine => My::Plugin->new); $self->pipeline->push(mine => My::Plugin->new); # to remove a plugin $self->plugin_del('mine'); # or the object $self->pipeline->remove('mine'); # or the object # to get a plugin my $plug = $self->plugin_get('mine'); my $plug = $self->pipeline->get('mine'); # there are other very specific operations that # the pipeline offers, demonstrated here: # to get the pipeline object itself my $pipe = $self->pipeline; # to install a plugin at the front of the pipeline $pipe->unshift(mine => My::Plugin->new); # to remove the plugin at the end of the pipeline my $plug = $pipe->pop; # to remove the plugin at the front of the pipeline my $plug = $pipe->shift; # to replace a plugin with another $pipe->replace(mine => newmine => My::Plugin->new); # to insert a plugin before another $pipe->insert_before(mine => newmine => My::Plugin->new); # to insert a plugin after another $pipe->insert_after(mine => newmine => My::Plugin->new); # to get the location in the pipeline of a plugin my $index = $pipe->get_index('mine'); # to move a plugin closer to the front of the pipeline $pipe->bump_up('mine'); # to move a plugin closer to the end of the pipeline $pipe->bump_down('mine'); =head1 DESCRIPTION Object::Pluggable::Pipeline defines the Plugin pipeline system for L instances. =head1 METHODS =head2 C Takes one argument, the Object::Pluggable object to attach to. =head2 C Takes at least two arguments, an alias for a plugin and the plugin object itself. Any extra arguments will be passed to the register method of the plugin object. If a plugin with that alias already exists, C<$@> will be set and C will be returned. Otherwise, it adds the plugin to the end of the pipeline and registers it. This will yield a C event. If successful, it returns the size of the pipeline. my $new_size = $pipe->push($name, $plug, @register_args); =head2 C Takes at least two arguments, an alias for a plugin and the plugin object itself. Any extra arguments will be passed to the register method of the plugin object. If a plugin with that alias already exists, C<$@> will be set and C will be returned. Otherwise, it adds the plugin to the beginning of the pipeline and registers it. This will yield a C event. If successful, it returns the size of the pipeline. my $new_size = $pipe->push($name, $plug, @register_args); =head2 C Takes any number of arguments. The first plugin in the pipeline is removed. Any arguments will be passed to the unregister method of the plugin object. This will yield a C event. In list context, it returns the plugin and its alias; in scalar context, it returns only the plugin. If there were no elements, an empty list or C will be returned. my ($plug, $name) = $pipe->shift(@unregister_args); my $plug = $pipe->shift(@unregister_args); =head2 C Takes any number of arguments. The last plugin in the pipeline is removed. Any arguments will be passed to the unregister method of the plugin object. This will yield an C event. In list context, it returns the plugin and its alias; in scalar context, it returns only the plugin. If there were no elements, an empty list or C will be returned. my ($plug, $name) = $pipe->pop(@unregister_args); my $plug = $pipe->pop(@unregister_args); =head2 C Takes at least three arguments, the old plugin or its alias, an alias for the new plugin and the new plugin object itself. You can optionally pass two array references of arguments which will be delivered to the unregister method of the old plugin and the register method of the new plugin, respectively. If you only want to pass the latter, you can put C in place of the former. If the old plugin doesn't exist, or if there is already a plugin with the new alias (besides the old plugin), C<$@> will be set and C will be returned. Otherwise, it removes the old plugin (yielding an C event) and replaces it with the new plugin. This will yield an C event. If successful, it returns 1. my $success = $pipe->replace($name, $new_name, $new_plug, \@unregister_args, \@register_args); my $success = $pipe->replace($plug, $new_name, $new_plug, \@unregister_args, \@register_args); =head2 C Takes at least three arguments, the plugin that is relative to the operation, an alias for the new plugin and the new plugin object itself. Any extra arguments will be passed to the register method of the new plugin object. If the first plugin doesn't exist, or if there is already a plugin with the new alias, C<$@> will be set and C will be returned. Otherwise, the new plugin is placed just prior to the other plugin in the pipeline. If successful, it returns 1. my $success = $pipe->insert_before($name, $new_name, $new_plug, @register_args); my $success = $pipe->insert_before($plug, $new_name, $new_plug, @register_args); =head2 C Takes at least three arguments, the plugin that is relative to the operation, an alias for the new plugin and the new plugin object itself. any extra arguments will be passed to the register method of the new plugin object. If the first plugin doesn't exist, or if there is already a plugin with the new alias, C<$@> will be set and C will be returned. Otherwise, the new plugin is placed just after to the other plugin in the pipeline. If successful, it returns 1. my $success = $pipe->insert_after($name, $new_name, $new_plug, @register_args); my $success = $pipe->insert_after($plug, $new_name, $new_plug, @register_args); =head2 C Takes one or two arguments, the plugin or its alias, and the distance to bump the plugin. The distance defaults to 1. If the plugin doesn't exist, C<$@> will be set and B<-1 will be returned, not undef>. Otherwise, the plugin will be moved the given distance closer to the front of the pipeline. A warning is issued alerting you if it would have been moved past the beginning of the pipeline, and the plugin is placed at the beginning. If successful, the new index of the plugin in the pipeline is returned. my $pos = $pipe->bump_up($name); my $pos = $pipe->bump_up($plug); my $pos = $pipe->bump_up($name, $delta); my $pos = $pipe->bump_up($plug, $delta); =head2 C Takes one or two arguments, the plugin or its alias, and the distance to bump the plugin. The distance defaults to 1. If the plugin doesn't exist, C<$@> will be set and B<-1 will be returned, not C>. Otherwise, the plugin will be moved the given distance closer to the end of the pipeline. A warning is issued alerting you if it would have been moved past the end of the pipeline, and the plugin is placed at the end. If successful, the new index of the plugin in the pipeline is returned. my $pos = $pipe->bump_down($name); my $pos = $pipe->bump_down($plug); my $pos = $pipe->bump_down($name, $delta); my $pos = $pipe->bump_down($plug, $delta); =head2 C Takes at least one argument, a plugin or its alias. Any arguments will be passed to the unregister method of the plugin object. If the plugin doesn't exist, C<$@> will be set and C will be returned. Otherwise, the plugin is removed from the pipeline. This will yield an C event. In list context, it returns the plugin and its alias; in scalar context, it returns only the plugin. my ($plug, $name) = $pipe->remove($the_name, @unregister_args); my ($plug, $name) = $pipe->remove($the_plug, @unregister_args); my $plug = $pipe->remove($the_name, @unregister_args); my $plug = $pipe->remove($the_plug, @unregister_args); =head2 C Takes one argument, a plugin or its alias. If no such plugin exists, C<$@> will be set and C will be returned. In list context, it returns the plugin and its alias; in scalar context, it returns only the plugin. my ($plug, $name) = $pipe->get($the_name); my ($plug, $name) = $pipe->get($the_plug); my $plug = $pipe->get($the_name); my $plug = $pipe->get($the_plug); =head2 C Takes one argument, a plugin or its alias. If no such plugin exists, C<$@> will be set and B<-1 will be returned, not C>. Otherwise, the index in the pipeline is returned. my $pos = $pipe->get_index($name); my $pos = $pipe->get_index($plug); =head1 BUGS None known so far. =head1 AUTHOR Jeff C Pinyan, F. =head1 MAINTAINER Chris C Williams, F. =head1 SEE ALSO L. L, =cut Constants.pm000644001750001750 304711453754351 22772 0ustar00hinrikhinrik000000000000Object-Pluggable-1.29/lib/Object/Pluggablepackage Object::Pluggable::Constants; BEGIN { $Object::Pluggable::Constants::AUTHORITY = 'cpan:HINRIK'; } BEGIN { $Object::Pluggable::Constants::VERSION = '1.29'; } use strict; use warnings; require Exporter; use base qw(Exporter); our @EXPORT_OK = qw( PLUGIN_EAT_NONE PLUGIN_EAT_CLIENT PLUGIN_EAT_PLUGIN PLUGIN_EAT_ALL ); our %EXPORT_TAGS = ( ALL => [@EXPORT_OK] ); use constant { PLUGIN_EAT_NONE => 1, PLUGIN_EAT_CLIENT => 2, PLUGIN_EAT_PLUGIN => 3, PLUGIN_EAT_ALL => 4, }; 1; __END__ =encoding utf8 =head1 NAME Object::Pluggable::Constants - Importable constants for Object::Pluggable =head1 SYNOPSIS use Object::Pluggable::Constants qw(:ALL); =head1 DESCRIPTION Object::Pluggable::Constants defines a number of constants that are required by the plugin system. =head1 EXPORTS =head2 C Value: 1 This means the event will continue to be processed by remaining plugins and finally, sent to interested sessions that registered for it. =head2 C Value: 2 This means the event will continue to be processed by remaining plugins but it will not be sent to any sessions that registered for it. =head2 C Value: 3 This means the event will not be processed by remaining plugins, it will go straight to interested sessions. =head2 C Value: 4 This means the event will be completely discarded, no plugin or session will see it. =head1 MAINTAINER Chris 'BinGOs' Williams =head1 SEE ALSO L =cut