Data-Keys

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Data::Keys

0.04   27 November 2016
    * skip testing on windows

0.03    9 October 2016
    * fix test expecting english locale errors (#1, thanks Slaven Rezić for reporting)
    * fix unknown attributes test (#2, thanks Slaven Rezić for reporting)

0.02    15 Oct 2010
    * avoid deadlocks in lock dir (key will be locked only once)
    * pass all self+key+value to key adapt and (in|de)flate
    * allow deleting with uniq set
    * added Key::AutoLock

0.01    Date/time
        First version, released on an unsuspecting world.

lib/Data/Keys/E/Dir/Lock.pm  view on Meta::CPAN

sub lock_ex {
    my $self = shift;
    my $key  = shift;

    my $lock_key = $key;
    $lock_key    =~ s{/}{_}g;
    my $lock_filename = File::Spec->catfile($self->lock_dir, $lock_key);

    $self->_lock_dir_data->{$key}->{'counter'}++;
    # return if already locked
    return
        if ($self->_lock_dir_data->{$key}->{'counter'} != 1);

    my $lock_fh;
    my $num_tries = 0;
    # try to exclusively open the lock the file, if it fails than wait until another process release the LOCK_EX
    while (not sysopen($lock_fh, $lock_filename, O_WRONLY | O_EXCL | O_CREAT, 0644)) {
        # wait until lock on that file is released
        eval {
            my $fh = IO::Any->new([$lock_filename], '+>>', { LOCK_EX => 1 });

lib/Data/Keys/E/Dir/Lock.pm  view on Meta::CPAN

Release a lock.

=cut

sub unlock {
    my $self = shift;
    my $key  = shift;
    
    if (not $self->_lock_dir_data->{$key}) {
        warn 'unlock("'.$key.'") but is is not locked';
        return;
    };

    $self->_lock_dir_data->{$key}->{'counter'}--;

    if ($self->_lock_dir_data->{$key}->{'counter'} <= 0) {
        # release+delete lock file
        unlink delete $self->_lock_dir_data->{$key}->{'filename'};
        close delete $self->_lock_dir_data->{$key}->{'fh'};
        delete $self->_lock_dir_data->{$key};

t/03_Data-Keys_locking_dir.t  view on Meta::CPAN

	);

	is($ts->get('abcd'), (), 'get non-existing file');
	is($ts->set('abcd', 123), 'abcd', 'set');
	is_deeply(IO::Any->slurp([$tmp_folder, 'abcd']), 123, 'read the file directly');	
	
	TEST_FILE_LOCKING: {
		my $lock_filename = File::Spec->catfile($ts->lock_dir, 'abcd');
		my $lock_fh       = IO::Any->new([$lock_filename], '+>>', { LOCK_EX => 1 });
		
		my $locked = 1;
		local $SIG{'ALRM'} = sub {
			$locked = 2;
			unlink($lock_filename);
			close($lock_fh);
		};
		alarm(1);
		is($ts->get('abcd'), 123, 'get (should be blocked)');
		is($locked, 2, 'lock released');

		$locked  = 1;
		$lock_fh = IO::Any->new([$lock_filename], '+>>', { LOCK_EX => 1 });
		alarm(1);
		is($ts->set('abcd', 1234), 'abcd', 'set (should be blocked)');
		is($locked, 2, 'lock released');
		is($ts->get('abcd'), 1234, 'verify the value');
	}
	
	TEST_SEMAPHORE_FILE_UNLINKING: {
		my $sem_lock_filename = File::Spec->catfile($tmp_folder, '.lock', '123');
		do {
			my $ts2 = Data::Keys->new(
				'base_dir'    => $tmp_folder,
				'extend_with' => ['Store::Dir', 'Dir::Lock', 'Locking'],
			);

t/03_Data-Keys_locking_inplace.t  view on Meta::CPAN

		'extend_with' => ['Store::Dir', 'Dir::LockInPlace', 'Locking'],
	);

	is($ts->get('abcd'), (), 'get non-existing file');
	$ts->set('abcd', 123);
	is($ts->set('abcd', 123), 'abcd', 'set');
	is_deeply(IO::Any->slurp([$tmp_folder, 'abcd']), 123, 'read the file directly');

	SHARED_LOCK: {
		my $lock_fh = IO::Any->new([$tmp_folder, 'abcd'], '+>>', { LOCK_SH => 1 });
		is($ts->get('abcd'), 123, 'get shared locked file is fine');

		my $pid = fork(); die 'fork failed' if not defined $pid;
		if (not $pid) {
			sleep(1);
			close($lock_fh);
			exit;
		}
		close($lock_fh);
		throws_ok { IO::Any->new([$tmp_folder, 'abcd'], '+>>', { LOCK_EX => 1, LOCK_NB => 1 }) } qr/flock failed/, 'file locked preventing LOCK_EX';
		is($ts->set('abcd', 456), 'abcd', 'set (should be blocked)');
		lives_ok { IO::Any->new([$tmp_folder, 'abcd'], '+>>', { LOCK_EX => 1, LOCK_NB => 1 }) } 'and unlocked';
	}
	
	EXCLUSIVE_LOCK: {
		my $lock_fh = IO::Any->new([$tmp_folder, 'abcdx'], '+>>', { LOCK_EX => 1 });
		my $pid = fork(); die 'fork failed' if not defined $pid;
		if (not $pid) {
			sleep(1);
			close($lock_fh);
			exit;
		}
		close($lock_fh);
		throws_ok { IO::Any->new([$tmp_folder, 'abcdx'], '+>>', { LOCK_SH => 1, LOCK_NB => 1 }) } qr/flock failed/, 'file locked preventing LOCK_SH';;
		is($ts->set('abcdx', 456), 'abcdx', 'set (should be blocked)');
		lives_ok { IO::Any->new([$tmp_folder, 'abcdx'], '+>>', { LOCK_EX => 1, LOCK_NB => 1 }) } 'and unlocked';
	}
	
	return 0;
}