App::CPAN2Pkg::Lock - use Moose;

App-CPAN2Pkg documentation Contained in the App-CPAN2Pkg distribution.

Index

Code Index:

NAME

Top

App::CPAN2Pkg::Lock - use Moose;

VERSION

Top

version 2.111781

SYNOPSIS

Top

    use App::CPAN2Pkg::Lock;
    my $lock = App::CPAN2Pkg::Lock->new;
    $lock->get( 'foo' );
    # ...
    $lock->is_available; # false
    $lock->owner;        # foo
    $lock->get( 'bar' ); # dies
    # ...
    $lock->release;

DESCRIPTION

Top

This class implements a simple locking mechanism.

ATTRIBUTES

Top

owner

The lock owner (a string).

METHODS

Top

is_available

    $lock->is_available;

Return true if one can get control on $lock.

get

    $lock->get( $owner );

Try to give the $lock control to $owner. Dies if it's already owned by something else, or if new $owner is not specified.

release

    $lock->release;

Release $lock. It's now available for locking again.

AUTHOR

Top

Jerome Quelin <jquelin@gmail.com>

COPYRIGHT AND LICENSE

Top

This software is copyright (c) 2009 by Jerome Quelin.

This is free software; you can redistribute it and/or modify it under the same terms as the Perl 5 programming language system itself.

App-CPAN2Pkg documentation Contained in the App-CPAN2Pkg distribution. 
#
# This file is part of App-CPAN2Pkg
#
# This software is copyright (c) 2009 by Jerome Quelin.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#
use 5.012;
use strict;
use warnings;

package App::CPAN2Pkg::Lock;
BEGIN {
  $App::CPAN2Pkg::Lock::VERSION = '2.111781';
}
# ABSTRACT:

use Moose;
use MooseX::Has::Sugar;

# -- attributes


has owner => (
    rw,
    isa       => 'Str',
    writer    => '_set_owner',
    clearer   => '_clear_owner',
    predicate => '_has_owner',
);


# -- methods


sub is_available {
    my $self = shift;
    return ! $self->_has_owner;
}



sub get {
    my ($self, $owner) = @_;
    die "need to specify owner parameter" unless defined $owner;
    if ( $self->_has_owner ) {
        my $current = $self->owner;
        die "lock already owned by $current";
    }
    $self->_set_owner( $owner );
}



sub release {
    my $self = shift;
    $self->_clear_owner;
}

1;




__END__