view release on metacpan or  search on metacpan

lib/CHI/Driver/SharedMem.pm  view on Meta::CPAN

	$self->_unlock();
	my @keys_in_lru_order =
		sort { $last_used_time->{$a} <=> $last_used_time->{$b} } $self->get_keys();
	return sub {
		shift(@keys_in_lru_order);
	};
}

# Internal routines

# The area must be locked by the caller
sub _build_shm {
	my $self = shift;
	my $shm_size = $self->shm_size();

	if((!defined($shm_size)) || ($shm_size == 0)) {
		# Probably some strange condition in cleanup
		# croak 'Size == 0';
		return;
	}
	my $shm = IPC::SharedMem->new($self->shm_key(), $shm_size, S_IRUSR|S_IWUSR);

lib/CHI/Driver/SharedMem.pm  view on Meta::CPAN

	# }
	return unless $self->lock_file();

	if(my $lock = $self->lock_fd()) {
		# print $tulip "locking\n";
		flock($lock, ($params{type} eq 'read') ? Fcntl::LOCK_SH : Fcntl::LOCK_EX);
	} else {
		# print $tulip 'lost lock ', $self->lock_file(), "\n";
		croak('Lost lock: ', $self->lock_file());
	}
	# print $tulip "locked\n";
	# close $tulip;
}

sub _unlock {
	my $self = shift;

	# open(my $tulip, '>>', '/tmp/tulip');
	# print $tulip 'unlock ', $self->lock_file(), "\n";
	# my $i = 0;
	# while((my @call_details = (caller($i++)))) {

lib/CHI/Driver/SharedMem.pm  view on Meta::CPAN

	# }
	if(my $lock = $self->lock_fd()) {
		flock($lock, Fcntl::LOCK_UN);
	} else {
		# print $tulip 'lost lock for unlock ', $self->lock_file(), "\n";
		croak('Lost lock for unlock: ', $self->lock_file());
	}
	# close $tulip;
}

# The area must be locked by the caller
sub _data_size {
	my($self, $value) = @_;

	if(!$self->shm()) {
		croak __PACKAGE__, ': panic: _data_size has lost the shared memory segment';
		return 0;
	}
	if(defined($value)) {
		$self->shm()->write(pack('I', $value), 0, $Config{intsize});
		return $value;
	}
	my $size = $self->shm()->read(0, $Config{intsize});
	unless(defined($size)) {
		return 0;
	}
	return unpack('I', $size);
}

# The area must be locked by the caller
sub _data {
	my($self, $h) = @_;

	# open(my $tulip, '>>', '/tmp/tulip');
	# print $tulip __LINE__, "\n";
	if(defined($h)) {
		my $f = JSON::MaybeXS->new()->ascii(1)->encode($h);
		my $cur_size = length($f);
		# print $tulip __LINE__, " cmp $cur_size > ", $self->shm_size(), "\n";
		if($cur_size > ($self->shm_size() - $Config{intsize})) {