
use strict;

package Mail::Box::Locker;

use Carp;

=head1 NAME

Mail::Box::Locker - Manage the locking of mail-folders

=head1 SYNOPSIS

   use Mail::Box;
   use Mail::Box::Locker;
   my $locker = new Mail::Box::Locker(folder => $folder);

   $locker->lock;
   $locker->isLocked;
   $locker->hasLock;
   $locker->unlock;

   my $folder = new Mail::Box(lock_method => 'DOTLOCK');
   print $folder->lockMethod;
   $folder->lock;
   $folder->isLocked;
   $folder->hasLock;
   $folder->unlock;

=head1 DESCRIPTION

Read L<Mail::Box::Manager> first.
The locker module contains the various locking functionalities as
needed when handling mail-folders.

Each Mail::Box-folder will create its own Mail::Box::Locker object,
which will handle the locking for it.  You can access of the object
directly from the folder, as shown in the examples below.  Sometimes
the names of the methods had to be changed to avoid confusion.

=head1 METHOD

=over 4

=cut

#-------------------------------------------

=item new ARGS

Create a new lock.  You may do this, however, in most cases the lock will
not be seperately instantiated but be the second class in a multiple
inheritance construction with a L<Mail::Box>.

ARGS is a reference to a hash, where the following fields are used
for the locker information:

=over 4

=item * lock_method =E<gt> METHOD | OBJECT

Which METHOD has to be used for locking.  Supported are

=over 4

=item 'DOTLOCK' | 'dotlock'

The folder handler creates a file which signals that it is in use.  This
is a bit problematic, because all mail-handling software should agree on
the name of the file to be created.

On various folder-types, the lockfile differs.  See each manual-page
and special options to change their default behavior.

=item 'FILE' | 'file'

For some folder handlers, locking is based on simply file-locking
mechanism.  However, this does not work on network filesystems, and
such.  This also doesn't work on directory-type of folders (Mail::Box::Dir
and derived).

=item 'NFS' | 'nfs'

A kind of C<dotlock> file-locking mechanism, but adapted to work over
NFS.  Extra precaution is needed because an C<open O_EXCL> on NFS is
not an atomic action.

=item 'NONE' | 'none'

Disable locking.

=back

The other option (but this is implemented in Mail::Box) is to
produce your own Mail::Box::Locker derived class, which implements
the desired locking method [you may consider to offer it for inclusion
in the public Mail::Box module]   Create an instance of that class
with this parameter:

   my $locker = Mail::Box::Locker::MyOwn->new;
   $folder->open(lock_method => $locker);

=item * lock_timeout =E<gt> SECONDS

How long can a lock stand?  When an different e-mail program left a
lock, then this will be removed automatically after the specified
seconds.  The default is one hour.

=item * lock_wait =E<gt> SECONDS|'NOTIMEOUT'

How long to wait for receiving the lock.  The lock-request may fail,
when the specified number of seconds is reached.  If 'NOTIMEOUT' is
specified, we wait till the lock can be taken.

It is platform and locking method specific whether it is possible at
all to limit the trials to the specified number of seconds.  For instance,
the `dotlock' method on Windows will always wait until the lock has been
received.

=item * lock_file =E<gt> FILENAME

Name of the file to take the lock on or to represent a lock (depends on
the kind of lock used).

=back

=cut

my %lockers = ( DOTLOCK => __PACKAGE__ .'::DotLock'
              , FILE    => __PACKAGE__ .'::File'
              , NFS     => __PACKAGE__ .'::NFS'
              , NONE    => __PACKAGE__
              );

sub new(@)
{   my ($class, %args) = @_;
    my $method = uc $args{lock_method} || 'DOTLOCK';
    my $create = $lockers{$method};

    local $" = ' or ';
    confess "No locking method $method defined: use @{[ keys %lockers ]}"
        unless $create;

    $args{lock_method} = $method;

    # compile the locking module (if needed)
    eval "require $create";
    confess $@ if $@;

    (bless {}, $create)->init(\%args);
}

sub init($)
{   my ($self, $args) = @_;

    $self->{MBL_folder}   = $args->{folder}
        or confess "No folder specified at creation lock-object.";

    $self->{MBL_method}   = $args->{lock_method};
    $self->{MBL_timeout}  = $args->{lock_timeout}   || 3600;
    $self->{MBL_wait}     = $args->{lock_wait}      || 10;
    $self->{MBL_lock_file}= $args->{lock_file};
    $self->{MBL_has_lock} = 0;

    $self;
}

#-------------------------------------------

=item name

Return the way this folder was locked.  It can only be set as option
to the creation of a folder.  The method-name is returned in uppercase.
You can also get the name of the locking method via the C<lockMethod>
call of a Mail::Box folder.

Examples:

    if($locker->name eq 'FILE') ...
    if($folder->lockMethod eq 'FILE') ...

=cut

sub name() { shift->{MBL_method} }

#-------------------------------------------

sub lockingMethod($$$$)
{   confess "Method removed: use inheritance to implement own method."
}

#-------------------------------------------
#
# These default methods are the implementation of the 'NONE'-method.
#

=back

=head2 Basic functions

=over 4

=item lock FOLDER

Get a lock on a folder.  This will return false if the lock fails.

Examples:

    die unless $locker->lock;
    if($folder->lock) {...}

=cut

sub lock($) { shift->{MBL_has_lock} = 1 }

#-------------------------------------------

=item isLocked

Test if the folder is locked by this or a different application.

Examples:

    if($locker->isLocked) {...}
    if($folder->isLocked) {...}

=cut

sub isLocked($) {0}

#-------------------------------------------

=item hasLock

Check whether the folder has the lock.

Examples:

    if($locker->hasLock) {...}
    if($folder->hasLock) {...}

=cut

sub hasLock() { shift->{MBL_has_lock} }

#-------------------------------------------

=item unlock

Undo the lock on a folder.

Examples:

    $locker->unlock;
    $folder->unlock;

=cut

# implementation hazard: the unlock must be self-suppliant, without
# help by the folder, because it may be called at global destruction
# after the folder has been removed.

sub unlock() { shift->{MBL_has_lock} = 0 }

#-------------------------------------------

=item filename

Returns the filename which is used to lock the folder.  It depends on the
locking method how this file is used.

Examples:

   print $locker->filename;
   print $folder->lockFilename;

=cut

sub filename($)
{   my $self   = shift;
    return $self->{MBL_filename} if defined $self->{MBL_filename};

    my $folder = $self->{MBL_folder};
    $self->{MBL_filename}
        = $folder->can('filename')  ? $folder->filename  . '.lock'
        : $folder->can('directory') ? $folder->directory . '/.lock'
        : croak "Need lock-file name.";
}

sub DESTROY()
{   my $self = shift;
    $self->unlock if $self->hasLock;
}

#-------------------------------------------

=back

=head1 AUTHOR

Mark Overmeer (F<Mark@Overmeer.net>).
All rights reserved.  This program is free software; you can redistribute
it and/or modify it under the same terms as Perl itself.

=head1 VERSION

This code is beta, version 1.324

=cut

1;
