view release on metacpan or  search on metacpan

lib/Apache/Session/Lock/File.pm  view on Meta::CPAN

    die "No read lock to release in release_read_lock" unless $self->{read};
    
    if (!$self->{write}) {
        flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
        close $self->{fh} || die "Could no close file: $!";
        $self->{opened} = 0;
    }
    
    $self->{read} = 0;
}

sub release_write_lock {
    my $self    = shift;
    my $session = shift;
    
    die "No write lock acquired" unless $self->{write};
    
    if ($self->{read}) {
        flock($self->{fh}, LOCK_SH) || die "Cannot lock: $!";
    }
    else {
        flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
        close $self->{fh} || die "Could not close file: $!";
        $self->{opened} = 0;
    }
    
    $self->{write} = 0;
}

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

    if ($self->{opened}) {
        flock($self->{fh}, LOCK_UN) || die "Cannot unlock: $!";
        close $self->{fh} || die "Could not close file: $!";
    }
    
    $self->{opened} = 0;
    $self->{read}   = 0;
    $self->{write}  = 0;
}

sub DESTROY {
    my $self = shift;
    
    $self->release_all_locks;
}

sub clean {
    my $self = shift;
    my $dir  = shift;
    my $time = shift;

    my $now = time();
    
    opendir(DIR, $dir) || die "Could not open directory $dir: $!";
    my @files = readdir(DIR);
    foreach my $file (@files) {
        if ($file =~ /^Apache-Session.*\.lock$/) {
            if ($now - (stat($dir.'/'.$file))[8] >= $time) {
              if ($^O eq 'MSWin32') {
                #Windows cannot unlink open file
                unlink($dir.'/'.$file) || next;
              } else {
                open(FH, "+>$dir/".$file) || next;
                flock(FH, LOCK_EX) || next;
                unlink($dir.'/'.$file) || next;
                flock(FH, LOCK_UN);
                close(FH);
              }
            }
        }
    }
    closedir(DIR);
}

1;

=pod

=head1 NAME

Apache::Session::Lock::File - Provides mutual exclusion using flock

=head1 SYNOPSIS

 use Apache::Session::Lock::File;

 my $locker = Apache::Session::Lock::File->new;

 $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);

 $locker->clean($dir, $age);

=head1 DESCRIPTION

Apache::Session::Lock::File fulfills the locking interface of 
Apache::Session.  Mutual exclusion is achieved through the use of temporary
files and the C<flock> function.

=head1 CONFIGURATION

The module must know where to create its temporary files.  You must pass an
argument in the usual Apache::Session style.  The name of the argument is
LockDirectory and its value is the path where you want the lockfiles created.
Example:

 tie %s, 'Apache::Session::Blah', $id, {LockDirectory => '/var/lock/sessions'}

If you do not supply this argument, temporary files will be created in /tmp.

=head1 NOTES

=head2 clean

This module does not unlink temporary files, because it interferes with proper