The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
############################################################################
#
# Apache::Session::Lock::Semaphore
# IPC Semaphore locking for Apache::Session
# Copyright(c) 1998, 1999, 2000 Jeffrey William Baker (jwbaker@acm.org)
# Distribute under the Artistic License
#
############################################################################

package Apache::Session::Lock::Semaphore;

use strict;
use Config;
use IPC::SysV qw(IPC_CREAT S_IRWXU SEM_UNDO);
use IPC::Semaphore;
use vars qw($VERSION);

$VERSION = '1.01';

sub BEGIN {

    if ($Config{'osname'} eq 'linux') {
        #More semaphores on Linux means less lock contention
        $Apache::Session::Lock::Semaphore::nsems = 32;
    }
    else {
        $Apache::Session::Lock::Semaphore::nsems = 16;
    }
    
    $Apache::Session::Lock::Semaphore::sem_key = 31818;
}

sub new {
    my $class   = shift;
    my $session = shift;
    
    my $nsems = $session->{args}->{NSems} ||
        $Apache::Session::Lock::Semaphore::nsems;
    
    my $sem_key = $session->{args}->{SemaphoreKey} ||
        $Apache::Session::Lock::Semaphore::sem_key;

    return bless {read => 0, write => 0, sem => undef, nsems => $nsems, 
        read_sem => undef, sem_key => $sem_key}, $class;
}

sub acquire_read_lock  {
    my $self    = shift;
    my $session = shift;

    return if $self->{read};
    return if $self->{write};

    if (!$self->{sem}) {    
        $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems},
            IPC_CREAT | S_IRWXU) || die $!;
    }
    
    if (!defined $self->{read_sem}) {
        #The number of semaphores (2^2-2^4, typically) is much less than
        #the potential number of session ids (2^128, typically), we need 
        #to hash the session id to choose a sempahore.  This hash routine
        #was stolen from Kernighan's The Practice of Programming.

        my $read_sem = 0;
        foreach my $el (split(//, $session->{data}->{_session_id})) {
            $read_sem = 31 * $read_sem + ord($el);
        }
        $read_sem %= ($self->{nsems}/2);
        
        $self->{read_sem} = $read_sem;
    }    
    
    #The sempahore block is divided into two halves.  The lower half
    #holds the read sempahores, and the upper half holds the write
    #semaphores.  Thus we can do atomic upgrade of a read lock to a
    #write lock.
    
    $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
                     $self->{read_sem},                    1, SEM_UNDO);
    
    $self->{read} = 1;
}

sub acquire_write_lock {    
    my $self    = shift;
    my $session = shift;

    return if($self->{write});

    if (!$self->{sem}) {
        $self->{sem} = new IPC::Semaphore($self->{sem_key}, $self->{nsems}, 
            IPC_CREAT | S_IRWXU) || die $!;
    }
    
    if (!defined $self->{read_sem}) {
        #The number of semaphores (2^2-2^4, typically) is much less than
        #the potential number of session ids (2^128, typically), we need 
        #to hash the session id to choose a sempahore.  This hash routine
        #was stolen from Kernighan's The Practice of Programming.

        my $read_sem = 0;
        foreach my $el (split(//, $session->{data}->{_session_id})) {
            $read_sem = 31 * $read_sem + ord($el);
        }
        $read_sem %= ($self->{nsems}/2);
        
        $self->{read_sem} = $read_sem;
    }    
    
    $self->release_read_lock($session) if $self->{read};

    $self->{sem}->op($self->{read_sem},                    0, SEM_UNDO,
                     $self->{read_sem} + $self->{nsems}/2, 0, SEM_UNDO,
                     $self->{read_sem} + $self->{nsems}/2, 1, SEM_UNDO);
    
    $self->{write} = 1;
}

sub release_read_lock  {
    my $self    = shift;

    my $session = shift;
    
    return unless $self->{read};

    $self->{sem}->op($self->{read_sem}, -1, SEM_UNDO);
    
    $self->{read} = 0;
}

sub release_write_lock {
    my $self    = shift;
    my $session = shift;
    
    return unless $self->{write};
    
    $self->{sem}->op($self->{read_sem} + $self->{nsems}/2, -1, SEM_UNDO);

    $self->{write} = 0;
}

sub release_all_locks  {
    my $self    = shift;
    my $session = shift;

    if($self->{read}) {
        $self->release_read_lock($session);
    }
    if($self->{write}) {
        $self->release_write_lock($session);
    }
    
    $self->{read}  = 0;
    $self->{write} = 0;
}

sub hash {
    my $key   = shift;
    my $nsems = shift;
    my $hash = 0;


}

1;


=pod

=head1 NAME

Apache::Session::Lock::Semaphore - Provides mutual exclusion through sempahores

=head1 SYNOPSIS

 use Apache::Session::Lock::Semaphore;
 
 my $locker = new Apache::Session::Lock::Semaphore;
 
 $locker->acquire_read_lock($ref);
 $locker->acquire_write_lock($ref);
 $locker->release_read_lock($ref);
 $locker->release_write_lock($ref);
 $locker->release_all_locks($ref);

=head1 DESCRIPTION

Apache::Session::Lock::Sempahore fulfills the locking interface of 
Apache::Session.  Mutual exclusion is achieved through system semaphores and
the IPC::Semaphore module.

=head1 CONFIGURATION

The module must know how many semaphores to use, and what semaphore key to
use.  The number of semaphores has an impact on performance.  More semaphores
meansless lock contention.  You should use the maximum number of sempahores
that your platform will allow.  On stock NetBSD, OpenBSD, and Solaris systems,
this is probably 16.  On Linux 2.2, this is 32.  This module tries to guess
the number based on your operating system, but it is safer to configure it
yourself.

To set the number of semaphores, you need to pass an argument in the usual
Apache::Session style.  The name of the argument is NSems, and the value is
an integer power of 2.  For example:

 tie %s, 'Apache::Session::Blah', $id, {NSems => 16};

You may also need to configure the semaphore key that this package uses.  By
default, it uses key 31818.  You can change this using the argument
SemaphoreKey:

 tie %s, 'Apache::Session::Blah', $id, {NSems => 16, SemaphoreKey => 42};

=head1 PROBLEMS

There are a few problems that people frequently encounter when using this
package.

If you get an invalid argument message, that usually means that the system
is unhappy with the number of semaphores that you requested.  Try decreasing
the number of semaphores.  The semaphore blocks that this package creates
are persistent until the system is rebooted, so if you request 8 sempahores
one time and 16 sempahores the next, it won't work.  Use the system
commands ipcs and ipcrm to inspect and remove unwanted semphore blocks.

=head1 AUTHOR

This module was written by Jeffrey William Baker <jwbaker@acm.org>.

=head1 SEE ALSO

L<Apache::Session>