home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / Controls.pm < prev    next >
Encoding:
Perl POD Document  |  2004-04-17  |  4.0 KB  |  189 lines
  1. # $Id: Controls.pm,v 1.2 2004/04/17 17:10:59 sungo Exp $
  2.  
  3. package POE::Resources::Controls;
  4.  
  5. use vars qw($VERSION);
  6. $VERSION = do {my@r=(q$Revision: 1.2 $=~/\d+/g);sprintf"%d."."%04d"x$#r,@r};
  7.  
  8. # We fold all this stuff back into POE::Kernel
  9. package POE::Kernel;
  10.  
  11. use strict;
  12. use Sys::Hostname;
  13.  
  14. # %kr_magic = (
  15. #   'foo'           => 'value',
  16. #   'bar.baz'       => 'value',
  17. #   'bar.bat'       => 'value',
  18. #   'bat.boo.buz'   => 'value',
  19. # );
  20.  
  21. my %kr_magic;
  22. my %kr_magic_locks;
  23.  
  24.  
  25.  
  26. # Populate the data store with a few  locked variables
  27. sub _data_magic_initialize {
  28.     my $self = shift;
  29.    
  30.     $kr_magic{'kernel.id'} = $self->ID;
  31.     $kr_magic{'kernel.hostname'} = hostname();
  32.  
  33.     $self->_data_magic_lock('kernel.id');
  34.     $self->_data_magic_lock('kernel.hostname');
  35.  
  36. }
  37.  
  38.  
  39. # Tear down everything. 
  40. sub _data_magic_finalize {
  41.     my $self = shift;
  42.  
  43.     %kr_magic = ();
  44.     %kr_magic_locks = ();
  45. }
  46.  
  47.  
  48. # Set the value of a magic entry. On success, returns
  49. # the stored value of the entry. On failure, returns
  50. # undef. If the entry is locked, no write is performed
  51. # and the pre-set-request value remains.
  52. sub _data_magic_set {
  53.     my $self = shift;
  54.  
  55.     return unless @_ == 2;
  56.  
  57.     unless(defined $kr_magic_locks{ $_[0] }) {
  58.         $kr_magic{ $_[0] } = $_[1];
  59.     }
  60.  
  61.     return $kr_magic{ $_[0] };
  62.  
  63. }
  64.  
  65. # Get the value of a magic entry. If the entry 
  66. # is defined, return its value. Otherwise, return
  67. # undef
  68. sub _data_magic_get {
  69.     my $self = shift;
  70.     
  71.     if(@_ == 1) {
  72.    
  73.         if(defined $kr_magic{ $_[0] }) {
  74.             return $kr_magic{ $_[0] };
  75.         } else {
  76.             return;
  77.         }
  78.         
  79.     } else {
  80.         my %magic_copy = %kr_magic;
  81.         return \%magic_copy;
  82.     }
  83.         
  84.     return;
  85. }
  86.  
  87.  
  88. # Lock a magic entry and prevent it from 
  89. # being written to.
  90. sub _data_magic_lock {
  91.     my $self = shift;
  92.     
  93.     my $pack = (caller())[0];
  94.  
  95.     # A kind of cheesy but functional level of protection.
  96.     # If you're in the POE namespace, you probably know enough
  97.     # to muck with magic locks. 
  98.     return unless $pack =~ /^POE::/;
  99.  
  100.     return unless @_ == 1;
  101.  
  102.     $kr_magic_locks{ $_[0] } = 1;
  103.    
  104.     return 1; 
  105. }
  106.  
  107.  
  108. # Clear the lock on a magic entry and allow 
  109. # it to be written to.
  110. sub _data_magic_unlock {
  111.     my $self = shift;
  112.  
  113.     my $pack = (caller())[0];
  114.  
  115.     # A kind of cheesy but functional level of protection.
  116.     # If you're in the POE namespace, you probably know enough
  117.     # to muck with magic locks. 
  118.     return unless $pack =~ /^POE::/;
  119.  
  120.     return unless @_ == 1;
  121.    
  122.     delete $kr_magic_locks{ $_[0] };
  123.    
  124.     return 1;
  125. }
  126.  
  127.  
  128.  
  129.  
  130.  
  131. 1;
  132. __END__
  133.  
  134. =head1 NAME
  135.  
  136. POE::Resource::Controls -- Switches and Knobs for POE Internals 
  137.  
  138. =head1 SYNOPSIS
  139.  
  140.     my $new_value = $k->_data_magic_set('kernel.pie' => 'tasty');
  141.     my $value = $k->_data_magic_get('kernel.pie');
  142.     my $ctls = $k->_data_magic_get();
  143.     $k->_data_magic_lock('kernel.pie');
  144.     $k->_data_magic_unlock('kernel.pie');
  145.  
  146. =head1 DESCRIPTION
  147.  
  148. =head2 _data_magic_set
  149.  
  150.     my $new_value = $k->_data_magic_set('kernel.pie' => 'tasty');
  151.     
  152. Set a control entry. Returns new value of control entry. If entry value 
  153. did not change, this entry is locked from writing.
  154.  
  155. =head2 _data_magic_get
  156.  
  157.     my $value = $k->_data_magic_get('kernel.pie');
  158.  
  159. Get the value of a control entry. If no entry name is provided, returns 
  160. a hash reference containing a copy of all control entries.
  161.  
  162. =head2 _data_magic_lock
  163.  
  164.     $k->_data_magic_lock('kernel.pie');
  165.  
  166. Lock a control entry from write. This call can only be made from 
  167. within a POE namespace.
  168.  
  169. =head2 _data_magic_unlock
  170.  
  171.     $k->_data_magic_unlock('kernel.pie');
  172.  
  173. Unlock a control entry. This allows the entry to be written to again.
  174. This call can only be made from within a POE namespace.
  175.     
  176. =head1 SEE ALSO
  177.  
  178. See L<POE::Kernel> and L<POE::API::Ctl>.
  179.  
  180.  
  181. =head1 AUTHORS & COPYRIGHTS
  182.  
  183. Original Author: Matt Cashner (sungo@pobox.com)
  184.  
  185. Please see L<POE> for more information about authors and contributors.
  186.  
  187. =cut
  188.  
  189.