Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

add in the new POE::Resource::Controls and POE::API::Ctl modules. yay ra

  • Loading branch information...
commit 864dcd219d251303659203b127f317823510a6f7 1 parent d048e5e
@sungo sungo authored
View
4 MANIFEST
@@ -11,6 +11,7 @@ README
TODO
lib/POE.pm
lib/POE/API/ResLoader.pm
+lib/POE/API/Ctl.pm
lib/POE/Component.pm
lib/POE/Component/Client/TCP.pm
lib/POE/Component/Server/TCP.pm
@@ -46,6 +47,7 @@ lib/POE/Queue.pm
lib/POE/Queue/Array.pm
lib/POE/Resource.pm
lib/POE/Resource/Aliases.pm
+lib/POE/Resource/Controls.pm
lib/POE/Resource/Events.pm
lib/POE/Resource/Extrefs.pm
lib/POE/Resource/FileHandles.pm
@@ -131,8 +133,10 @@ t/27_poll.t
t/28_windows.t
t/29_sockfact6.t
t/30_filter_httpd.t
+t/api/ctl.t
t/regress/neyuki-detach.t
t/res/aliases.t
+t/res/controls.t
t/res/events.t
t/res/extrefs.t
t/res/filehandles.t
View
93 lib/POE/API/Ctl.pm
@@ -0,0 +1,93 @@
+#$Id$
+
+package POE::API::Ctl;
+
+use warnings;
+use strict;
+
+use vars qw($VERSION);
+$VERSION = do {my@r=(q$Revision$=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
+
+use POE::Kernel;
+use POE::Resource::Controls;
+
+use Carp;
+
+sub import {
+ my $package = caller();
+
+ no strict 'refs';
+ *{ $package . '::poectl' } = \&poectl;
+}
+
+
+sub poectl {
+ if(scalar @_ == 2) {
+ return $poe_kernel->_data_magic_set($_[0] => $_[1]);
+ } elsif(scalar @_ == 1) {
+ return $poe_kernel->_data_magic_get($_[0]);
+ } elsif(scalar @_ == 0) {
+ return $poe_kernel->_data_magic_get();
+ } else {
+ carp "Unexpected number of arguments (".scalar @_.") to poectl()";
+ return;
+ }
+}
+
+
+1;
+__END__
+
+=head1 NAME
+
+POE::API::Ctl -- Switches and Knobs for POE Internals
+
+=head1 SYNOPSIS
+
+ use POE::API::Ctl;
+
+ my $value = poectl('kernel.id');
+
+ my $new_value = poectl('some.name' => 'pie');
+
+ my $ctls = poectl();
+
+=head1 DESCRIPTION
+
+This module provides C<sysctl> like functionality for POE. It exports
+into the calling namespace a function named C<poectl>.
+
+=head1 FUNCTIONS
+
+=head2 poectl
+
+ my $value = poectl('kernel.id');
+ my $new_value = poectl('some.name' => 'pie');
+ my $ctls = poectl();
+
+This function is exported into the calling namespace on module load. It
+provides the ability to get and set POE control values. All parameters
+are optional. If no parameters are given, a hash reference containing a
+copy of all POE control entries is returned. If one parameter is given,
+the value of that POE control entry is returned. If two parameters are
+given, the value of the POE control entry referenced by the first
+parameter is set to the contents of the second parameter. In this case,
+the new value of the POE control entry is returned. If more than two
+parameters are given, an error is thrown and undef is returned.
+
+Control entries can be locked by the POE internals. If a write is
+attempted to a locked entry, the write will not succeed and the old
+value will remain.
+
+=head1 SEE ALSO
+
+See L<POE::Kernel> and L<POE::Resource::Controls>.
+
+=head1 AUTHORS & COPYRIGHTS
+
+Original Author: Matt Cashner (sungo@pobox.com)
+
+Please see L<POE> for more information about authors and contributors.
+
+=cut
+
View
3  lib/POE/Kernel.pm
@@ -639,7 +639,6 @@ sub new {
undef, # KR_SIZE
\$kr_run_warning, # KR_RUN
\$kr_active_event, # KR_ACTIVE_EVENT
-
], $type;
POE::Resources->initialize();
@@ -666,6 +665,7 @@ sub new {
$self->_initialize_kernel_session();
$self->_data_stat_initialize() if TRACE_STATISTICS;
$self->_data_sig_initialize();
+ $self->_data_magic_initialize();
# These other subsystems don't have strange interactions.
$self->_data_handle_initialize($kr_queue);
@@ -986,6 +986,7 @@ sub finalize_kernel {
$self->_data_ev_finalize();
$self->_data_ses_finalize();
$self->_data_stat_finalize() if TRACE_PROFILE or TRACE_STATISTICS;
+ $self->_data_magic_finalize();
}
sub run_one_timeslice {
View
189 lib/POE/Resource/Controls.pm
@@ -0,0 +1,189 @@
+# $Id$
+
+package POE::Resources::Controls;
+
+use vars qw($VERSION);
+$VERSION = do {my@r=(q$Revision$=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
+
+# We fold all this stuff back into POE::Kernel
+package POE::Kernel;
+
+use strict;
+use warnings;
+use Sys::Hostname;
+
+# %kr_magic = (
+# 'foo' => 'value',
+# 'bar.baz' => 'value',
+# 'bar.bat' => 'value',
+# 'bat.boo.buz' => 'value',
+# );
+
+my %kr_magic;
+my %kr_magic_locks;
+
+
+
+# Populate the data store with a few locked variables
+sub _data_magic_initialize {
+ my $self = shift;
+
+ $kr_magic{'kernel.id'} = $self->ID;
+ $kr_magic{'kernel.hostname'} = hostname();
+
+ $self->_data_magic_lock('kernel.id');
+ $self->_data_magic_lock('kernel.hostname');
+
+}
+
+
+# Tear down everything.
+sub _data_magic_finalize {
+ my $self = shift;
+
+ %kr_magic = ();
+ %kr_magic_locks = ();
+}
+
+
+# Set the value of a magic entry. On success, returns
+# the stored value of the entry. On failure, returns
+# undef. If the entry is locked, no write is performed
+# and the pre-set-request value remains.
+sub _data_magic_set {
+ my $self = shift;
+
+ return unless @_ == 2;
+
+ unless(defined $kr_magic_locks{ $_[0] }) {
+ $kr_magic{ $_[0] } = $_[1];
+ }
+
+ return $kr_magic{ $_[0] };
+
+}
+
+# Get the value of a magic entry. If the entry
+# is defined, return its value. Otherwise, return
+# undef
+sub _data_magic_get {
+ my $self = shift;
+
+ if(@_ == 1) {
+
+ if(defined $kr_magic{ $_[0] }) {
+ return $kr_magic{ $_[0] };
+ } else {
+ return;
+ }
+
+ } else {
+ my %magic_copy = %kr_magic;
+ return \%magic_copy;
+ }
+
+ return;
+}
+
+
+# Lock a magic entry and prevent it from
+# being written to.
+sub _data_magic_lock {
+ my $self = shift;
+
+ my $pack = (caller())[0];
+
+ # A kind of cheesy but functional level of protection.
+ # If you're in the POE namespace, you probably know enough
+ # to muck with magic locks.
+ return unless $pack =~ /^POE::/;
+
+ return unless @_ == 1;
+
+ $kr_magic_locks{ $_[0] } = 1;
+
+ return 1;
+}
+
+
+# Clear the lock on a magic entry and allow
+# it to be written to.
+sub _data_magic_unlock {
+ my $self = shift;
+
+ my $pack = (caller())[0];
+
+ # A kind of cheesy but functional level of protection.
+ # If you're in the POE namespace, you probably know enough
+ # to muck with magic locks.
+ return unless $pack =~ /^POE::/;
+
+ return unless @_ == 1;
+
+ delete $kr_magic_locks{ $_[0] };
+
+ return 1;
+}
+
+
+
+
+
+1;
+__END__
+
+=head1 NAME
+
+POE::Resource::Controls -- Switches and Knobs for POE Internals
+
+=head1 SYNOPSIS
+
+ my $new_value = $k->_data_magic_set('kernel.pie' => 'tasty');
+ my $value = $k->_data_magic_get('kernel.pie');
+ my $ctls = $k->_data_magic_get();
+ $k->_data_magic_lock('kernel.pie');
+ $k->_data_magic_unlock('kernel.pie');
+
+=head1 DESCRIPTION
+
+=head2 _data_magic_set
+
+ my $new_value = $k->_data_magic_set('kernel.pie' => 'tasty');
+
+Set a control entry. Returns new value of control entry. If entry value
+did not change, this entry is locked from writing.
+
+=head2 _data_magic_get
+
+ my $value = $k->_data_magic_get('kernel.pie');
+
+Get the value of a control entry. If no entry name is provided, returns
+a hash reference containing a copy of all control entries.
+
+=head2 _data_magic_lock
+
+ $k->_data_magic_lock('kernel.pie');
+
+Lock a control entry from write. This call can only be made from
+within a POE namespace.
+
+=head2 _data_magic_unlock
+
+ $k->_data_magic_unlock('kernel.pie');
+
+Unlock a control entry. This allows the entry to be written to again.
+This call can only be made from within a POE namespace.
+
+=head1 SEE ALSO
+
+See L<POE::Kernel> and L<POE::API::Ctl>.
+
+
+=head1 AUTHORS & COPYRIGHTS
+
+Original Author: Matt Cashner (sungo@pobox.com)
+
+Please see L<POE> for more information about authors and contributors.
+
+=cut
+
View
1  lib/POE/Resources.pm
@@ -14,6 +14,7 @@ my @resources = qw(
POE::XS::Resource::Sessions
POE::XS::Resource::Signals
POE::XS::Resource::Statistics
+ POE::XS::Resource::Controls
);
sub initialize {
View
52 tests/api/ctl.t
@@ -0,0 +1,52 @@
+# $Id$
+
+use strict;
+
+use lib qw(./mylib ../mylib ./lib ../lib ../../lib);
+
+use Test::More qw(no_plan);
+
+BEGIN { use_ok('POE'); use_ok('POE::API::Ctl'); }
+
+use POE::API::Ctl; # to get the export
+
+is( poectl('kernel.id'),
+ $poe_kernel->ID,
+ "equality test between kernel id control entry and actual kernel id"
+ );
+
+is( poectl('kernel.id' => 'pie'),
+ $poe_kernel->ID,
+ "kernel.id immutability test"
+ );
+
+is( poectl('kernel.pie' => 'tasty'),
+ 'tasty',
+ 'set a new value'
+ );
+
+is( poectl('kernel.pie'),
+ 'tasty',
+ 'get the new value',
+ );
+
+
+my $ctls;
+eval { $ctls = poectl() };
+is($@,'','no params exception check');
+
+is(ref $ctls, 'HASH', 'data structure ref check');
+
+foreach my $key (qw(kernel.id kernel.hostname kernel.pie)) {
+ ok(defined delete $ctls->{$key}, "$key existence check");
+}
+
+is(keys %$ctls, 0, "Unknown key check");
+
+my $ctls2;
+$ctls2 = poectl();
+foreach my $key (qw(kernel.id kernel.hostname kernel.pie)) {
+ ok(defined delete $ctls2->{$key}, "$key existence check (verifying copy-on-get)");
+}
+
+
View
91 tests/res/controls.t
@@ -0,0 +1,91 @@
+# $Id$
+
+use strict;
+
+use lib qw(./mylib ../mylib ./lib ../lib ../../lib);
+
+use Test::More qw(no_plan);
+
+BEGIN { use_ok('POE'); use_ok('POE::Resource::Controls'); }
+
+eval { $poe_kernel->_data_magic_initialize; };
+is($@,'', "_data_magic_initialize exception check");
+
+is( $poe_kernel->_data_magic_get('kernel.id'),
+ $poe_kernel->ID,
+ "equality test between kernel id control entry and actual kernel id"
+ );
+
+is( $poe_kernel->_data_magic_set('kernel.id' => 'pie'),
+ $poe_kernel->ID,
+ "kernel.id immutability test"
+ );
+
+is( $poe_kernel->_data_magic_set('kernel.pie' => 'tasty'),
+ 'tasty',
+ 'set a new value'
+ );
+
+is( $poe_kernel->_data_magic_get('kernel.pie'),
+ 'tasty',
+ 'get the new value',
+ );
+
+
+is( $poe_kernel->_data_magic_lock('kernel.pie'),
+ undef,
+ 'lock source protection',
+ );
+
+is( $poe_kernel->_data_magic_unlock('kernel.pie'),
+ undef,
+ 'unlock source protection',
+ );
+
+package POE::Magic::Test;
+
+use POE;
+use Test::More;
+
+is( $poe_kernel->_data_magic_lock('kernel.pie'),
+ 1,
+ 'lock',
+ );
+
+is( $poe_kernel->_data_magic_set('kernel.pie' => 'yucky'),
+ 'tasty',
+ 'check lock immutability'
+ );
+
+
+is( $poe_kernel->_data_magic_unlock('kernel.pie'),
+ 1,
+ 'unlock',
+ );
+
+
+is( $poe_kernel->_data_magic_set('kernel.pie' => 'yucky'),
+ 'yucky',
+ 'check unlock mutability'
+ );
+
+
+my $ctls;
+eval { $ctls = $poe_kernel->_data_magic_get() };
+is($@,'','_data_magic_get with no params exception check');
+
+is(ref $ctls, 'HASH', 'data structure ref check');
+
+foreach my $key (qw(kernel.id kernel.hostname kernel.pie)) {
+ ok(defined delete $ctls->{$key}, "$key existence check");
+}
+
+is(keys %$ctls, 0, "Unknown key check");
+
+my $ctls2;
+$ctls2 = $poe_kernel->_data_magic_get();
+foreach my $key (qw(kernel.id kernel.hostname kernel.pie)) {
+ ok(defined delete $ctls2->{$key}, "$key existence check (verifying copy-on-get)");
+}
+
+
Please sign in to comment.
Something went wrong with that request. Please try again.