Class-Maker

 view release on metacpan or  search on metacpan

lib/Class/Maker/Examples/Lockable.pm  view on Meta::CPAN

package Lockable;

our $VERSION = '0.03';

require 5.005_62; use strict; use warnings;

Class::Maker::class
{
	public =>
	{
		bool => [ qw( locked blocked ) ],

		int => [qw( limited passed failed )],

		string => [ qw( passkey unlockkey ) ],
	},
};

sub _preinit
{
	my $this = shift;

		$this->unlockkey(1);

		$this->locked(1);

		$this->blocked(0);

		$this->passed(0);

		$this->limited(5);
}

sub lock
{
	my $this = shift;

		warn 'Closing lock' if $Class::Maker::DEBUG;

return $this->locked(1);
}

sub block
{
	my $this = shift;

		warn 'Blocking lock!' if $Class::Maker::DEBUG;

return $this->blocked(1);
}

sub unlock
{
	my $this = shift;

		warn 'Opening lock' if $Class::Maker::DEBUG;

		if( $this->blocked )
		{
			warn 'Cant unlock, because blocked !' if $Class::Maker::DEBUG;

			return $this->locked(1);
		}

return $this->locked(0);
}

sub unblock
{
	my $this = shift;

		warn 'Unblocking lock' if $Class::Maker::DEBUG;

return $this->blocked(0);
}

sub try
{
	my $this = shift;

	my %args = @_;

		warn 'Try lock' if $Class::Maker::DEBUG;

		if( $this->blocked )
		{
			warn 'Try failed - Lock is blocked !' if $Class::Maker::DEBUG;

			return $this->locked;
		}

		if( $this->unlockkey )
		{
			warn 'Require Key' if $Class::Maker::DEBUG;

			if( exists $args{KEY} )
			{
				if( $this->passkey eq $args{KEY} )
				{

lib/Class/Maker/Examples/Lockable.pm  view on Meta::CPAN


					$this->unlock;
				}
			}
			else
			{
				warn 'Key required through ->unlockkey param, but try( KEY => ) is missing';
			}
		}

		if( $this->locked )
		{
			$this->failed( $this->failed + 1 );

			if( $this->failed > $this->limited )
			{
				$this->block();
			}
		}
		else
		{
			$this->failed( 0 );

			$this->passed( $this->passed + 1 );
		}

return $this->locked;
}

sub assert
{
	my $this = shift;

		if( $this->locked )
		{
			print "Wrong Key\n";
		}
		else
		{
			print "Lock passed !\n";
		}
}

1;



( run in 1.145 second using v1.01-cache-2.11-cpan-49f99fa48dc )