
use strict;

package Mail::Box::Locker::Multi;
use base 'Mail::Box::Locker';

use IO::File;
use Carp;

=head1 NAME

Mail::Box::Locker::Multi - lock a folder in all ways which work

=head1 CLASS HIERARCHY

 Mail::Box::Locker::Multi
 is a Mail::Box::Locker
 is a Mail::Reporter

=head1 SYNOPSIS

 See Mail::Box::Locker

=head1 DESCRIPTION

The C<::Multi> locker locks a folder in each way it can.  This way, the
chance is highest that any other program will leave the folder alone
during our access to it.

NFS-lock and Flock are tried.  More may be added when the ways to
lock are extended.  DotLock overlaps with NFS-lock, but NFS-lock is
safer, so that version is prefered.

=head1 METHOD INDEX

Methods prefixed with an abbreviation are described in
L<Mail::Reporter> (MR), L<Mail::Box::Locker> (MBL).

The general methods for C<Mail::Box::Locker::Multi> objects:

  MBL DESTROY                          MBL name
   MR errors                               new OPTIONS
  MBL filename                          MR report [LEVEL]
  MBL hasLock                           MR reportAll [LEVEL]
  MBL isLocked                          MR trace [LEVEL]
  MBL lock FOLDER                      MBL unlock
   MR log [LEVEL [,STRINGS]]            MR warnings

The extra methods for extension writers:

   MR AUTOLOAD                          MR logPriority LEVEL
   MR DESTROY                           MR logSettings
   MR inGlobalDestruction               MR notImplemented

=head1 METHODS

=over 4

=cut

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

sub name() {'MULTI'}

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

=item new OPTIONS

 OPTIONS        DESCRIBED IN               DEFAULT
 file           Mail::Box::Locker          undef
 folder         Mail::Box::Locker          <obligatory>
 log            Mail::Reporter             'WARNINGS'
 method         Mail::Box::Locker          <not used>
 expires        Mail::Box::Locker          1 hour
 trace          Mail::Reporter             'WARNINGS'
 timeout        Mail::Box::Locker          10 seconds
 use            Mail::Box::Locker::Multi   <all possible>

=over 4

=item * use =E<gt> ARRAY

Array of locker types and locker objects to be used to lock one
folder.  The type names are converted into objects.

Some locking types are not available on some platforms, so they will
not be excluded from the default list (NFS POSIX Flock).

=over

=cut

sub init($)
{   my ($self, $args) = @_;
    $self->SUPER::init($args);

    my @use
     = exists $args->{use} ? @{$args->{use}}
     : $^O =~ m/mswin/i    ? qw/    POSIX Flock/
     :                       qw/NFS POSIX Flock/;

    my (@lockers, @used);

    foreach my $method (@use)
    {   my $locker = eval
        {   Mail::Box::Locker->new
              ( %$args
              , method  => $method
              , timeout => 1
              )
        };
        next unless defined $locker;

        push @lockers, $locker;
        push @used, $method;
    }

    $self->{MBLM_lockers} = \@lockers;
    $self->log(PROGRESS => "Multi-locking via @used.");
    $self;
}

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

=item lockers

Returns a list with all locker objects used by this object.

=cut

sub lockers() { @{shift->{MBLM_lockers}} }

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

sub _try_lock($)
{   my $self     = shift;
    my @successes;

    foreach my $locker ($self->lockers)
    {
        unless($locker->lock)
        {   $_->unlock foreach @successes;
            return 0;
        }
        push @successes, $locker;
    }

    1;
}

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

sub unlock()
{   my $self = shift;
    return $self unless $self->{MBL_has_lock};

    $_->unlock foreach $self->lockers;
    delete $self->{MBL_has_lock};

    $self;
}

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

sub lock()
{   my $self  = shift;
    return 1 if $self->hasLock;

    my $end   = $self->{MBL_timeout} eq 'NOTIMEOUT' ? -1 : $self->{MBL_timeout};

    while(1)
    {   return $self->{MBL_has_lock} = 1
            if $self->_try_lock;

        last unless --$end;
        sleep 1;
    }

    return 0;
}

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

sub isLocked()
{   my $self     = shift;
    $self->_try_lock($self->filename) or return 0;
    $self->unlock;
    1;
}

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

=back

=head1 SEE ALSO

L<Mail::Box-Overview>

For support and additional documentation, see http://perl.overmeer.net/mailbox/

=head1 AUTHOR

Mark Overmeer (F<mailbox@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 2.018.

Copyright (c) 2001-2002 Mark Overmeer. All rights reserved.
This program is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut

1;
