"Fossies" - the Fresh Open Source Software Archive

Member "Apache-Session-1.93/lib/Apache/Session/Lock/Semaphore.pm" (15 Sep 2009, 8489 Bytes) of package /linux/www/Apache-Session-1.93.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Semaphore.pm" see the Fossies "Dox" file reference documentation.

    1 ############################################################################
    2 #
    3 # Apache::Session::Lock::Semaphore
    4 # IPC Semaphore locking for Apache::Session
    5 # Copyright(c) 1998, 1999, 2000 Jeffrey William Baker (jwbaker@acm.org)
    6 # Distribute under the Perl License
    7 #
    8 ############################################################################
    9 
   10 package Apache::Session::Lock::Semaphore;
   11 
   12 use strict;
   13 use Config;
   14 use IPC::SysV qw(IPC_PRIVATE IPC_CREAT S_IRWXU SEM_UNDO);
   15 use IPC::Semaphore;
   16 use Carp qw/croak confess/;
   17 use vars qw($VERSION);
   18 
   19 $VERSION = '1.04';
   20 
   21 BEGIN {
   22 
   23     if ($Config{'osname'} eq 'linux') {
   24         #More semaphores on Linux means less lock contention
   25         $Apache::Session::Lock::Semaphore::nsems = 32;
   26     } elsif ($Config{'osname'}=~/bsd/i) {
   27         $Apache::Session::Lock::Semaphore::nsems = 8; #copied from IPC::Semaphore/sem.t minus 1
   28     } else {
   29         $Apache::Session::Lock::Semaphore::nsems = 16;
   30     }
   31     
   32     $Apache::Session::Lock::Semaphore::sem_key = 31818;
   33 }
   34 
   35 sub new {
   36     return unless $Config{d_semget};
   37     return
   38         if $^O eq 'cygwin' && (!exists $ENV{'CYGWIN'} || $ENV{'CYGWIN'} !~ /server/i);
   39     #Modified by Alexandr Ciornii, 2007-03-12
   40 
   41     my $class   = shift;
   42     my $session = shift;
   43     
   44     my $nsems = $session->{args}->{NSems} ||
   45         $Apache::Session::Lock::Semaphore::nsems;
   46     
   47 #    die "You shouldn't set session argument SemaphoreKey to undef"
   48 #     if exists($session->{args}->{SemaphoreKey}) && 
   49 #        !defined ($session->{args}->{SemaphoreKey});
   50 
   51     my $sem_key = #exists ($session->{args}->{SemaphoreKey})?
   52         $session->{args}->{SemaphoreKey} || 
   53         $Apache::Session::Lock::Semaphore::sem_key;
   54 
   55     return bless {read => 0, write => 0, sem => undef, nsems => $nsems, 
   56         read_sem => undef, sem_key => $sem_key}, $class;
   57 }
   58 
   59 sub acquire_read_lock  {
   60     my $self    = shift;
   61     my $session = shift;
   62 
   63     return if $self->{read};
   64     return if $self->{write};
   65 
   66     if (!$self->{sem}) {    
   67         $self->{sem} = IPC::Semaphore->new(
   68             defined($self->{sem_key})?$self->{sem_key}:IPC_PRIVATE, $self->{nsems},
   69             IPC_CREAT | S_IRWXU) || confess("Cannot create semaphore with key $self->{sem_key}; NSEMS: $self->{nsems}: $!");
   70     }
   71     
   72     if (!defined $self->{read_sem}) {
   73         #The number of semaphores (2^2-2^4, typically) is much less than
   74         #the potential number of session ids (2^128, typically), we need
   75         #to hash the session id to choose a semaphore.  This hash routine
   76         #was stolen from Kernighan's The Practice of Programming.
   77 
   78         my $read_sem = 0;
   79         foreach my $el (split(//, $session->{data}->{_session_id})) {
   80             $read_sem = 31 * $read_sem + ord($el);
   81         }
   82         $read_sem %= ($self->{nsems}/2);
   83         
   84         $self->{read_sem} = $read_sem;
   85     }    
   86     
   87     #The semaphore block is divided into two halves.  The lower half
   88     #holds the read semaphores, and the upper half holds the write
   89     #semaphores.  Thus we can do atomic upgrade of a read lock to a
   90     #write lock.
   91     
   92     $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
   93                      $self->{read_sem},                    1, SEM_UNDO);
   94     
   95     $self->{read} = 1;
   96 }
   97 
   98 sub acquire_write_lock {    
   99     my $self    = shift;
  100     my $session = shift;
  101 
  102     return if($self->{write});
  103 
  104     if (!$self->{sem}) {
  105         $self->{sem} = IPC::Semaphore->new(
  106             defined($self->{sem_key})?$self->{sem_key}:IPC_PRIVATE, $self->{nsems},
  107             IPC_CREAT | S_IRWXU) || confess "Cannot create semaphore with key $self->{sem_key}; NSEMS: $self->{nsems}: $!";
  108     }
  109     
  110     if (!defined $self->{read_sem}) {
  111         #The number of semaphores (2^2-2^4, typically) is much less than
  112         #the potential number of session ids (2^128, typically), we need 
  113         #to hash the session id to choose a semaphore.  This hash routine
  114         #was stolen from Kernighan's The Practice of Programming.
  115 
  116         my $read_sem = 0;
  117         foreach my $el (split(//, $session->{data}->{_session_id})) {
  118             $read_sem = 31 * $read_sem + ord($el);
  119         }
  120         $read_sem %= ($self->{nsems}/2);
  121         
  122         $self->{read_sem} = $read_sem;
  123     }    
  124     
  125     $self->release_read_lock($session) if $self->{read};
  126 
  127     $self->{sem}->op($self->{read_sem},                    0, SEM_UNDO,
  128                      $self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
  129                      $self->{read_sem} + $self->{nsems}/2, 1, SEM_UNDO);
  130     
  131     $self->{write} = 1;
  132 }
  133 
  134 sub release_read_lock  {
  135     my $self    = shift;
  136 
  137     my $session = shift;
  138     
  139     return unless $self->{read};
  140 
  141     $self->{sem}->op($self->{read_sem}, -1, SEM_UNDO);
  142     
  143     $self->{read} = 0;
  144 }
  145 
  146 sub release_write_lock {
  147     my $self    = shift;
  148     my $session = shift;
  149     
  150     return unless $self->{write};
  151     
  152     $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, -1, SEM_UNDO);
  153 
  154     $self->{write} = 0;
  155 }
  156 
  157 sub release_all_locks  {
  158     my $self    = shift;
  159     my $session = shift;
  160 
  161     if($self->{read}) {
  162         $self->release_read_lock($session);
  163     }
  164     if($self->{write}) {
  165         $self->release_write_lock($session);
  166     }
  167     
  168     $self->{read}  = 0;
  169     $self->{write} = 0;
  170 }
  171 
  172 sub hash {
  173     my $key   = shift;
  174     my $nsems = shift;
  175     my $hash = 0;
  176 
  177 
  178 }
  179 
  180 sub remove {
  181     my $self    = shift;
  182     if ($self->{sem}) {    
  183         $self->{sem}->remove();
  184     }
  185 }
  186 
  187 1;
  188 
  189 
  190 =pod
  191 
  192 =head1 NAME
  193 
  194 Apache::Session::Lock::Semaphore - Provides mutual exclusion through semaphores
  195 
  196 =head1 SYNOPSIS
  197 
  198  use Apache::Session::Lock::Semaphore;
  199 
  200  my $locker = new Apache::Session::Lock::Semaphore;
  201  die "no semaphores" unless $locker;
  202 
  203  $locker->acquire_read_lock($ref);
  204  $locker->acquire_write_lock($ref);
  205  $locker->release_read_lock($ref);
  206  $locker->release_write_lock($ref);
  207  $locker->release_all_locks($ref);
  208 
  209 =head1 DESCRIPTION
  210 
  211 Apache::Session::Lock::semaphore fulfills the locking interface of 
  212 Apache::Session.  Mutual exclusion is achieved through system semaphores and
  213 the IPC::Semaphore module.
  214 
  215 =head1 CONFIGURATION
  216 
  217 The module must know how many semaphores to use, and what semaphore key to
  218 use. The number of semaphores has an impact on performance.  More semaphores
  219 means less lock contention. You should use the maximum number of semaphores
  220 that your platform will allow. On stock NetBSD, OpenBSD, and Solaris systems,
  221 this is probably 16. On Linux 2.2, this is 32. This module tries to guess
  222 the number based on your operating system, but it is safer to configure it
  223 yourself.
  224 
  225 To set the number of semaphores, you need to pass an argument in the usual
  226 Apache::Session style. The name of the argument is NSems, and the value is
  227 an integer power of 2. For example:
  228 
  229  tie %s, 'Apache::Session::Blah', $id, {NSems => 16};
  230 
  231 You may also need to configure the semaphore key that this package uses. By
  232 default, it uses key 31818.  You can change this using the argument
  233 SemaphoreKey:
  234 
  235  tie %s, 'Apache::Session::Blah', $id, {NSems => 16, SemaphoreKey => 42};
  236 
  237 =head1 PROBLEMS
  238 
  239 There are a few problems that people frequently encounter when using this
  240 package.
  241 
  242 If you get an invalid argument message, that usually means that the system
  243 is unhappy with the number of semaphores that you requested.  Try decreasing
  244 the number of semaphores.  The semaphore blocks that this package creates
  245 are persistent until the system is rebooted, so if you request 8 semaphores
  246 one time and 16 semaphores the next, it won't work.  Use the system
  247 commands ipcs and ipcrm to inspect and remove unwanted semphore blocks.
  248 
  249 =head2 Cygwin
  250 
  251 IPC on Cygwin requires running cygserver. Without it, program will exit with
  252 "Bad System call" message. It cannot be intercepted with eval.
  253 
  254 Read /usr/share/doc/Cygwin/cygserver.README for more information.
  255 
  256 =head2 Darwin/MacOS X
  257 
  258 Darwin and MacOS X may not have semaphores, see
  259 L<http://sysnet.ucsd.edu/~bellardo/darwin/sysvsem.html>
  260 
  261 =head2 *BSD
  262 
  263 Error "No space left on device" means that maximum number of semaphores is reached.
  264 See L<http://www.postgresql.org/docs/7.3/static/kernel-resources.html> for
  265 more information.
  266 
  267 =head1 AUTHOR
  268 
  269 This module was written by Jeffrey William Baker <jwbaker@acm.org>.
  270 
  271 =head1 SEE ALSO
  272 
  273 L<Apache::Session>