File Coverage

blib/lib/XAS/Lib/Lockmgr.pm

Criterion	Covered	Total	%
statement	9	76	11.8
branch	0	24	0.0
condition	0	3	0.0
subroutine	3	10	30.0
pod	6	6	100.0
total	18	119	15.1

package XAS::Lib::Lockmgr;

our $VERSION = '0.01';

use DateTime;
use DateTime::Span;

use XAS::Class
  debug     => 0,
  version   => $VERSION,
  base      => 'XAS::Singleton',
  mixin     => 'XAS::Lib::Mixins::Process',
  utils     => ':validation dotid load_module',
  accessors => 'lockers',
  constants => 'LOCK_DRIVERS TRUE FALSE HASHREF',
  vars => {
    PARAMS => {
      -deadlocked   => { optional => 1, default => 5 },
      -deadattempts => { optional => 1, default => 5 }
    }
  }
;

#use Data::Dumper;

# ----------------------------------------------------------------------
# Public Methods
# ----------------------------------------------------------------------

sub add {
    my $self = shift;
    my $p = validate_params(\@_, {
        -key    => 1,
        -args   => { optional => 1, default => {}, type => HASHREF },
        -driver => { optional => 1, default => 'Filesystem', regex => LOCK_DRIVERS },
    });

    my $key    = $p->{'key'};
    my $args   = $p->{'args'};
    my $module = 'XAS::Lib::Lockmgr::' . $p->{'driver'};

    unless (defined($self->lockers->{$key})) {

        load_module($module);

        $self->lockers->{$key} = $module->new(-key => $key, -args => $args);

    }

}

sub remove {
    my $self = shift;
    my ($key) = validate_params(\@_, [1]);

    my $stat;

    if (my $locker = $self->lockers->{$key}) {

        $stat = $locker->destroy();
        delete $self->lockers->{$key};

    } else {

        $self->throw_msg(
            dotid($self->class) . '.remove.nokey',
            'lock_nokey',
            $key
        );

    }

    return $stat;

}

sub lock {
    my $self = shift;
    my ($key) = validate_params(\@_, [1]);

    my $stat;
    my $attempts = 1;

    if (my $locker = $self->lockers->{$key}) {

        LOCK: {

            unless ($stat = $locker->lock()) {

                unless ($stat = $self->_deadlock($key)) {

                    $attempts += 1;
                    redo LOCK if ($attempts <= $self->deadattempts);

                }

            }

        }

    } else {

        $self->throw_msg(
            dotid($self->class) . '.lock.nokey',
            'lock_nokey',
            $key
        );

    }

    return $stat;

}

sub unlock {
    my $self = shift;
    my ($key) = validate_params(\@_, [1]);

    my $stat;

    if (my $locker = $self->lockers->{$key}) {

        $stat = $locker->unlock();

    } else {

        $self->throw_msg(
            dotid($self->class) . '.unlock.nokey',
            'lock_nokey',
            $key
        );

    }

    return $stat;

}

sub try_lock {
    my $self = shift;
    my ($key) = validate_params(\@_, [1]);

    my $stat;

    if (my $locker = $self->lockers->{$key}) {

        $stat = $locker->try_lock();

    } else {

        $self->throw_msg(
            dotid($self->class) . '.try_lock.nokey',
            'lock_nokey',
            $key
        );

    }

    return $stat;

}

# ----------------------------------------------------------------------
# Private Methods
# ----------------------------------------------------------------------

sub _deadlock {
    my $self = shift;
    my ($key) = validate_params(\@_, [1]);

    my $stat = FALSE;

    if (my $locker = $self->lockers->{$key}) {

        my $now = DateTime->now(time_zone => 'local');
        my ($host, $pid, $time) = $locker->whose_lock();

        $time->set_time_zone('local');

        my $span = DateTime::Span->from_datetimes(
            start => $now->clone->subtract(minutes => $self->deadlocked),
            end   => $now
        );

        $self->log->debug(sprintf('deadlock: start - %s', $span->start));
        $self->log->debug(sprintf('deadlock: end   - %s', $span->end));
        $self->log->debug(sprintf('deadlock: lock  - %s', $time));

        unless ($span->contains($time)) {

            if ($host eq $self->env->host) {

                my $status = $self->proc_status($pid);

                unless (($status == 3) || ($status == 2)) {

                    $locker->break_lock();
                    $self->log->warn_msg('lock_broken', $key);
                    $stat = TRUE;

                }

            } else {

                $self->throw_msg(
                    dotid($self->class) . '.deadlock.remote',
                    'lock_remote',
                    $key

                );

            }

        }

    } else {

        $self->throw_msg(
            dotid($self->class) . '.deadlock.nokey',
            'lock_nokey',
            $key
        );

    }

    return $stat;

}

sub init {
    my $class = shift;

    my $self = $class->SUPER::init(@_);

    $self->{'lockers'} = {};

    return $self;

}

1;

__END__