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

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

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
+

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 {

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
+

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 {

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)");
+}
+
+