Author: dylan
Date: 2005-04-10 07:09:22 -0400 (Sun, 10 Apr 2005)
New Revision: 667
Added:
trunk/misc/poe-session-plugin/t/001_plugin.t
trunk/misc/poe-session-plugin/t/002_loader.t
trunk/misc/poe-session-plugin/t/003_run.t
Removed:
trunk/main/server/lib/Haver/Server/Messages.pm
trunk/main/server/lib/Haver/Server/Messages/
Modified:
trunk/
trunk/dev-tools/vim-automod/template.pm
trunk/misc/poe-session-plugin/lib/POE/Session/Plugin.pm
trunk/misc/poe-session-plugin/lib/POE/Session/Plugin/Loader.pm
Log:
[EMAIL PROTECTED]: dylan | 2005-04-10 05:21:56 -0400
added fetch() method to the Loader, which returns the plugin
object.
Added a test case which + example which passes tests.
I could probably think of some more bizzare edge cases, but I don't feel like
it.
[EMAIL PROTECTED]: dylan | 2005-04-10 06:22:07 -0400
Added documentation and tests.
The docs suck, but bad docs are better than no docs.
[EMAIL PROTECTED]: dylan | 2005-04-10 06:25:12 -0400
heh, I renamed methods. I had to fix the tests to work.
D'oh!
[EMAIL PROTECTED]: dylan | 2005-04-10 06:58:14 -0400
added on_load and on_unload methods, which are called in POE context
during the loading and unloading of plugins.
I have not written any code to test them yet, though.
[EMAIL PROTECTED]: dylan | 2005-04-10 07:01:30 -0400
added test case for the on_load and on_unload semantics.
[EMAIL PROTECTED]: dylan | 2005-04-10 07:02:53 -0400
incremented the version number, hehe. ;)
[EMAIL PROTECTED]: dylan | 2005-04-10 07:09:04 -0400
Removed Messages, I need to re-write it anyway.
Fixed up the template a bit, still could be made better.
Property changes on: trunk
___________________________________________________________________
Name: svk:merge
- 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:908
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
+ 1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk:11166
1f59643a-e6e5-0310-bc24-f7d4c744f460:/haver/local/trunk-merge-10131:11178
27e50396-46e3-0310-8b22-ae223a1f35ce:/local:212
e9404bb1-7af0-0310-a7ff-e22194cd388b:/haver/local:918
edfcd8bd-4ce7-0310-a97e-bb1efd40edf3:/local:238
Modified: trunk/dev-tools/vim-automod/template.pm
===================================================================
--- trunk/dev-tools/vim-automod/template.pm 2005-04-10 08:42:53 UTC (rev
666)
+++ trunk/dev-tools/vim-automod/template.pm 2005-04-10 11:09:22 UTC (rev
667)
@@ -1,26 +1,17 @@
-# vim: set ts=4 sw=4 expandtab si ai sta tw=100:
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
# This module is copyrighted, see end of file for details.
package <<PACKAGE>>;
use strict;
use warnings;
-use base 'Haver::Object'; # Highly recommended for haver stuff.
-
our $VERSION = 0.01;
sub initialize {
- my ($me) = @_;
+ my ($me) = @_;
- # <<CURSOR>>
+ # <<CURSOR>>
}
-# use this instead of overriding DESTROY, if you extend Haver::Object.
-# sub finalize {
-# my ($me) = @_;
-#
-# }
-
-
1;
__END__
=head1 NAME
@@ -38,7 +29,7 @@
=head1 INHERITENCE
-<<PACKAGE>> extends L<Haver::Object>.
+<<PACKAGE>> extends blaa blaa blaa
=head1 CONSTRUCTOR
Deleted: trunk/main/server/lib/Haver/Server/Messages.pm
===================================================================
--- trunk/main/server/lib/Haver/Server/Messages.pm 2005-04-10 08:42:53 UTC
(rev 666)
+++ trunk/main/server/lib/Haver/Server/Messages.pm 2005-04-10 11:09:22 UTC
(rev 667)
@@ -1,42 +0,0 @@
-# vim: set ft=perl ts=4 sw=4:
-# Haver::Server::Event - Base class for
-#
-# Copyright (C) 2004 Dylan William Hardison.
-#
-# This module 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 2 of the License, or
-# (at your option) any later version.
-#
-# This module 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 module; if not, write to the Free Software
-# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
-package Haver::Server::Messages;
-use strict;
-use warnings;
-
-our $VERSION = '0.01';
-
-sub new {
- my $me = shift->SUPER::new(@_);
-
- if (ref($me) eq __PACKAGE__) {
- croak __PACKAGE__ . " is a virtual base class!";
- }
-}
-
-sub setup {
- my $me = shift;
-
- $me->provide_prefix('on_', $me->states);
- $me->provide_prefix_both('evt_', $me->events);
-}
-
-
-
-1;
Modified: trunk/misc/poe-session-plugin/lib/POE/Session/Plugin/Loader.pm
===================================================================
--- trunk/misc/poe-session-plugin/lib/POE/Session/Plugin/Loader.pm
2005-04-10 08:42:53 UTC (rev 666)
+++ trunk/misc/poe-session-plugin/lib/POE/Session/Plugin/Loader.pm
2005-04-10 11:09:22 UTC (rev 667)
@@ -1,33 +1,59 @@
-# vim: set ts=4 sw=4 expandtab si ai sta tw=100:
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
# This module is copyrighted, see end of file for details.
package POE::Session::Plugin::Loader;
use strict;
use warnings;
+use Carp;
our $VERSION = '0.04';
sub new {
my $class = shift;
my $self = {
- plugins => {},
+ plugins => {},
};
bless $self, $class;
}
-sub load {
- my ($self, $class, @args) = @_;
- my $object = $class->new(@args);
- $object->load;
- $self->{plugins}{$class} = $object;
+sub load_plugin {
+ my ($self, $class, @args) = @_;
+
+ if (exists $self->{plugins}{$class}) {
+ croak "Plugin $class already loaded!";
+ }
+
+ my $object = $class->new(@args);
+ $object->load;
+ $self->{plugins}{$class} = $object;
}
-sub unload {
- my ($self, $class) = @_;
- my $object = delete $self->{plugins}{$class};
- $object->unload;
+sub unload_plugin {
+ my ($self, $class) = @_;
+ my $object = delete $self->{plugins}{$class};
+ $object->unload;
}
+sub plugins {
+ my $self = shift;
+ keys %{ $self->{plugins} };
+}
+sub unload_all_plugins {
+ my ($self) = @_;
+ map { $self->unload($_) } $self->plugins
+}
+
+sub fetch_plugin {
+ my ($self, $class) = @_;
+
+ if (exists $self->{plugins}{$class}) {
+ $self->{plugins}{$class};
+ } else {
+ undef;
+ }
+}
+
+
1;
__END__
=head1 NAME
@@ -37,24 +63,55 @@
=head1 SYNOPSIS
use POE::Session::Plugin::Loader;
- # Small code example.
+ use MyPlugin;
+ # ... In some POE state ...
+ my $loader = POE::Session::Plugin::Loader;
+ $loader->load_plugin('MyPlugin', 'some', 'args');
+ $_[HEAP]{loader} = $loader;
+
=head1 DESCRIPTION
-FIXME
+This object maintains a list of plugin objects which have states loaded into a
session.
-=head1 CONSTRUCTOR
+FIXME: Write a better description.
-List required parameters for new().
-
=head1 METHODS
This class implements the following methods:
-=head2 method1(Z<>)
+=head2 new(Z<>)
-...
+This returns a new POE::Session::Plugin::Loader object.
+=head2 load_plugin($class, @args)
+
+Creates a new object of class $class, passing @args to its new() class method.
+The newly created object will have its load() method called, which should load
states into the
+currently active L<POE::Session>.
+
+For details on defining plugins, see L<POE::Session::Plugin>.
+
+=head2 unload_plugin($class)
+
+Call unload() on the object associated with $class,
+and then destroy the said object.
+
+=head2 plugins(Z<>)
+
+Returns a list of the currently loaded class names.
+
+=head2 fetch_plugin($class)
+
+Returns the plugin object of type $class.
+Returns undef if $class was never loaded.
+
+=head2 unload_all_plugins(Z<>)
+
+Unload all currently loaded plugins.
+
+This is called when the plugin loader is DESTROY()'d, so you never really need
to call it.
+
=head1 BUGS
None known. Bug reports are welcome. Please use our bug tracker at
@@ -62,11 +119,11 @@
=head1 AUTHOR
-Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
=head1 SEE ALSO
-L<http://www.haverdev.org/>.
+L<http://www.haverdev.org/>, L<POE>, L<POE::Session>, L<POE::NFA>.
=head1 COPYRIGHT and LICENSE
Modified: trunk/misc/poe-session-plugin/lib/POE/Session/Plugin.pm
===================================================================
--- trunk/misc/poe-session-plugin/lib/POE/Session/Plugin.pm 2005-04-10
08:42:53 UTC (rev 666)
+++ trunk/misc/poe-session-plugin/lib/POE/Session/Plugin.pm 2005-04-10
11:09:22 UTC (rev 667)
@@ -1,3 +1,5 @@
+# vim: set ts=4 sw=4 noexpandtab si ai sta tw=100:
+# This module is copyrighted, see end of file for details.
package POE::Session::Plugin;
use strict;
use warnings;
@@ -3,5 +5,5 @@
use Carp;
-our $VERSION = '0.04';
+our $VERSION = '0.06';
our $Kernel = $POE::Kernel::poe_kernel;
@@ -11,16 +13,30 @@
my $self = {
# I only prefix these with underscores because I am paranoid of
# subclasses clobbering them. :)
- _provided_states => [ ],
+ _provided_states => [],
_defined_states => { },
};
bless $self, $class;
+ $self->provide("${class}::load", 'on_load');
+ $self->provide("${class}::unload", 'on_unload');
$self->setup(@_);
return $self;
}
sub setup { }
+# POE state called when we load.
+sub on_load {
+
+}
+
+# POE state called when we unload.
+sub on_unload {
+
+}
+
+
+# This method is not really public. :)
sub kernel {
my ($self, $kernel) = @_;
$Kernel = $kernel;
@@ -41,17 +57,28 @@
keys %{ $self->{_defined_states} };
}
+
+sub invoke {
+ my $self = shift;
+ my $act = shift;
+ my $session = $Kernel->get_active_session();
+ my $class = ref $self;
+ $Kernel->call($session, join('::', $class, $act));
+}
+
# Load all provided states.
sub load {
my $self = shift;
map {
$self->define(@$_)
} $self->provided_states;
+ $self->invoke('load');
}
# Unload all *defined* states.
sub unload {
my $self = shift;
+ $self->invoke('unload');
map {
$self->undefine($_)
} $self->defined_states;
@@ -80,3 +107,107 @@
}
1;
+
+__END__
+=head1 NAME
+
+POE::Session::Plugin - Base class for modules that extend POE::Session at
runtime.
+
+=head1 SYNOPSIS
+
+ package MyPlugin;
+ use POE;
+ use base 'POE::Session::Plugin';
+
+ sub setup {
+ my $self = shift;
+ $self->provide('foo', 'on_foo');
+ }
+
+ sub on_foo {
+ my ($kernel, $heap, $self) = @_[KERNEL, HEAP, OBJECT];
+ # ...
+ }
+
+=head1 DESCRIPTION
+
+This module allows the loading and unloading of object states into a running
L<POE::Session>.
+
+Plugins are not unlike a L<POE::Wheel>, except instead of producing events,
they respond to them.
+
+This behavior is similar to that of L<POE::NFA>, except it is added to
existing L<POE::Session>
+sessions.
+
+=head1 METHODS
+
+This class implements the following methods:
+
+=head2 new(@args)
+
+This returns a new plugin object.
+Its arguments (@args) are passed to setup()
+
+=head2 setup()
+
+B<Do not call this method>. It is called by new().
+
+Subclasses should overload this method and use it call provide()
+to specify which states they define in the current session.
+
+=head2 define($state [, $method ])
+
+Bind $state in the currently active session to the method $method of $self.
+If $method is omitted, it defaults to the same name as $state.
+
+=head2 undefine($state)
+
+Remove the binding of $state in the current session, if and only if it was
previously
+defined by our $self.
+
+=head2 provide($state [, $method ])
+
+This is like a delayed define(). It will only occurs when load() is called.
+
+=head2 load(Z<>)
+
+Load all C<provide>'d states.
+
+=head2 unload(Z<>)
+
+This undefines (with undefine()) all states that were defined with define()
+or provided() and subsequently loaded with load().
+
+
+
+=head1 BUGS
+
+None known. Bug reports are welcome. Please use our bug tracker at
+L<http://gna.org/bugs/?func=additem&group=haver>.
+
+=head1 AUTHOR
+
+Dylan William Hardison, E<lt>[EMAIL PROTECTED]<gt>
+
+=head1 SEE ALSO
+
+L<http://www.haverdev.org/>, L<POE::Session::Plugin::Loader>,
+L<POE>, L<POE::Session>, L<POE::NFA>.
+
+=head1 COPYRIGHT and LICENSE
+
+Copyright (C) 2005 by Dylan William Hardison. All Rights Reserved.
+
+This module 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 2 of the License, or
+(at your option) any later version.
+
+This module 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 module; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
Added: trunk/misc/poe-session-plugin/t/001_plugin.t
===================================================================
--- trunk/misc/poe-session-plugin/t/001_plugin.t 2005-04-10 08:42:53 UTC
(rev 666)
+++ trunk/misc/poe-session-plugin/t/001_plugin.t 2005-04-10 11:09:22 UTC
(rev 667)
@@ -0,0 +1,25 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 4;
+
+my $class = 'POE::Session::Plugin';
+use_ok($class);
+can_ok($class, 'new');
+
+my $plugin = $class->new;
+
+isa_ok($plugin, $class);
+can_ok($plugin,
+ qw(
+ provide
+ load
+ unload
+ define
+ undefine
+ provided_states
+ defined_states
+ setup
+ kernel
+ )
+);
Added: trunk/misc/poe-session-plugin/t/002_loader.t
===================================================================
--- trunk/misc/poe-session-plugin/t/002_loader.t 2005-04-10 08:42:53 UTC
(rev 666)
+++ trunk/misc/poe-session-plugin/t/002_loader.t 2005-04-10 11:09:22 UTC
(rev 667)
@@ -0,0 +1,20 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 4;
+
+my $class = 'POE::Session::Plugin::Loader';
+require_ok($class);
+can_ok($class, 'new');
+
+my $loader = $class->new;
+isa_ok($loader, $class);
+can_ok($loader,
+ qw(
+ load_plugin
+ unload_plugin
+ plugins
+ fetch_plugin
+ unload_all_plugins
+ )
+);
Added: trunk/misc/poe-session-plugin/t/003_run.t
===================================================================
--- trunk/misc/poe-session-plugin/t/003_run.t 2005-04-10 08:42:53 UTC (rev
666)
+++ trunk/misc/poe-session-plugin/t/003_run.t 2005-04-10 11:09:22 UTC (rev
667)
@@ -0,0 +1,95 @@
+#!/usr/bin/perl
+# vim: set ft=perl:
+use strict;
+use Test::More tests => 7;
+use POE;
+use POE::Session::Plugin;
+use POE::Session::Plugin::Loader;
+
+BEGIN {
+ package MyPlugin;
+ use POE;
+ use base 'POE::Session::Plugin';
+
+ sub setup {
+ my $self = shift;
+ $self->provide('foo', 'on_foo');
+ $self->provide('bar', 'on_bar');
+ $self->provide('baz', 'on_baz');
+ }
+
+ sub on_load {
+ my $self = $_[OBJECT];
+ $self->{load} = 1;
+ }
+
+ sub on_unload {
+ my $self = $_[OBJECT];
+ $self->{unload} = 1;
+ }
+ sub on_foo {
+ my $self = $_[OBJECT];
+ $self->{foo}++;
+ }
+
+ sub on_bar {
+ my $self = $_[OBJECT];
+ $self->{bar}++;
+ }
+
+ sub on_baz {
+ my $self = $_[OBJECT];
+ $self->{baz}++;
+ if ($self->{baz} == 1) {
+ $_[KERNEL]->yield('bye');
+ }
+ }
+}
+
+POE::Session->create(
+ inline_states => {
+ _start => \&on_start,
+ _stop => \&on_stop,
+ bye => \&on_bye,
+ },
+);
+
+POE::Kernel->run;
+
+sub on_start {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $loader = new POE::Session::Plugin::Loader;
+ $loader->load_plugin('MyPlugin');
+ $heap->{loader} = $loader;
+
+ diag "Starting session";
+ foreach my $state (qw( foo bar baz )) {
+ $kernel->yield($state) for 1 .. 3;
+ }
+}
+
+sub on_stop {
+ diag "Stopping session";
+}
+
+sub on_bye {
+ my ($kernel, $heap) = @_[KERNEL, HEAP];
+ my $loader = $heap->{loader};
+ my $p = $loader->fetch_plugin('MyPlugin');
+
+ diag "Saying goodbye";
+ is($p->{foo}, 3, "Called foo 3 times");
+ is($p->{bar}, 3, "Called bar 3 times");
+ is($p->{baz}, 3, "Called baz 3 times");
+
+ diag "Calling foo again";
+ $kernel->call($_[SESSION], 'foo');
+ is($p->{foo}, 4, "foo is now 4");
+
+ diag "Unloading MyPlugin";
+ $loader->unload_plugin('MyPlugin');
+ $kernel->call($_[SESSION], 'foo');
+ isnt($p->{foo}, 5, "foo is not 5");
+ ok($p->{load}, "on_load was called.");
+ ok($p->{unload}, "on_unload was called.");
+}
