tags/0.4.3.1-pre2/SrSv/Shared.pm

   1 #       This file is part of SurrealServices.
   2 #
   3 #       SurrealServices is free software; you can redistribute it and/or modify
   4 #       it under the terms of the GNU General Public License as published by
   5 #       the Free Software Foundation; either version 2 of the License, or
   6 #       (at your option) any later version.
   7 #
   8 #       SurrealServices is distributed in the hope that it will be useful,
   9 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 #       GNU General Public License for more details.
  12 #
  13 #       You should have received a copy of the GNU General Public License
  14 #       along with SurrealServices; if not, write to the Free Software
  15 #       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
  16
  17 package SrSv::Shared;
  18
  19 =head1 NAME
  20
  21 SrSv::Shared - Share global variables among processes.
  22
  23 =cut
  24
  25 use strict;
  26
  27 use SrSv::Debug;
  28
  29 use SrSv::Process::Worker qw(ima_worker);
  30 use SrSv::Process::Init;
  31
  32 use SrSv::Shared::Scalar;
  33 use SrSv::Shared::Array;
  34 use SrSv::Shared::Hash;
  35
  36 our @shared_vars;
  37
  38 sub import {
  39         croak("Shared variables can only be created by the parent process")
  40                 if ima_worker;
  41
  42         my $class = shift;
  43         my ($package) = caller;
  44
  45         for (@_) {
  46                 my $var = $_;
  47                 my $sigil = substr($var, 0, 1, '');
  48                 my $pkgvar = "$package\::$var";
  49
  50                 push @shared_vars, [$sigil, $pkgvar];
  51
  52                 # make the variable accessable in the parent.
  53                 no strict 'refs';
  54                 *$pkgvar = (
  55                         $sigil eq '$' ? \$$pkgvar :
  56                         $sigil eq '@' ? \@$pkgvar :
  57                         $sigil eq '%' ? \%$pkgvar :
  58                         croak("Only scalars, arrays, and hashes are supported")
  59                 );
  60         }
  61 }
  62
  63 proc_init {
  64         return unless ima_worker;
  65         no strict 'refs';
  66
  67         for (@shared_vars) {
  68                 my ($sigil, $var) = @$_;
  69
  70                 if($sigil eq '$') {
  71                         tie ${$var}, 'SrSv::Shared::Scalar', $var;
  72                 }
  73                 elsif($sigil eq '@') {
  74                         tie @{$var}, 'SrSv::Shared::Array', $var;
  75                 }
  76                 elsif($sigil eq '%') {
  77                         tie %{$var}, 'SrSv::Shared::Hash', $var;
  78                 }
  79
  80                 print "$sigil$var is now shared.\n" if DEBUG;
  81         }
  82 };
  83
  84 1;
  85
  86 __END__
  87
  88 =head1 SYNOPSIS
  89
  90  use SrSv::Shared qw($shared1 @shared2 %shared3);
  91
  92 =head1 DESCRIPTION
  93
  94 This module creates shared variables.
  95
  96 =head1 CAVEATS
  97
  98 Operations which iterate through an entire hash are not supported.  This
  99 includes keys(), values(), each(), and assignment to list context.  If you need
 100 to do these things, do them in the parent process. (See SrSv::Process::InParent)