view release on metacpan or  search on metacpan

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

	# print $tulip "get: $cur_size bytes\n";
	if($cur_size) {
		my $rc;
		eval {
			$rc = JSON::MaybeXS->new()->ascii(1)->decode($self->shm()->read($Config{intsize}, $cur_size));
		};
		if($@) {
			$self->_lock(type => 'write');
			$self->_data_size(0);
			my $foo = $self->shm()->read($Config{intsize}, $cur_size);
			# print $tulip "\tDecode fail $cur_size bytes $@\n\t$foo\n";
			# my $i = 0;
			# while((my @call_details = (caller($i++)))) {
				# print $tulip "\t", $call_details[1], ':', $call_details[2], ' in function ', $call_details[3], "\n";
			# }
			croak($@);
			$self->_unlock();
		}
		return $rc;
		# return JSON::MaybeXS->new()->ascii(1)->decode($self->shm()->read($Config{intsize}, $cur_size));
	}
	# close $tulip;
	return {};
}

=head2 BUILD

Constructor - validate arguments

=cut

sub BUILD {
	my $self = shift;

	unless($self->shm_key()) {
		croak 'CHI::Driver::SharedMem - no shm_key given';
	}
	$| = 1;
}

=head2 DEMOLISH

If there is no data in the shared memory area, and no-one else is using it,
it's safe to remove it and reclaim the memory.

=cut

sub DEMOLISH {
	# if(defined($^V) && ($^V ge 'v5.14.0')) {
		# return if ${^GLOBAL_PHASE} eq 'DESTRUCT';	# >= 5.14.0 only
	# }
	my $self = shift;

	# open(my $tulip, '>>', '/tmp/tulip');
	# print $tulip "DEMOLISH\n";
	if($self->shm_key() && $self->shm()) {
		$self->_lock(type => 'write');
		my $cur_size = $self->_data_size();
		# print $tulip "DEMOLISH: $cur_size bytes\n";
		my $can_remove = 0;
		my $stat = $self->shm()->stat();
		if($cur_size == 0) {
			if(defined($stat) && ($stat->nattch() == 1)) {
				$self->shm()->detach();
				$self->shm()->remove();
				$can_remove = 1;
			}
		# } elsif(defined($stat) && ($stat->nattch() == 1)) {
			# # Scan the cache and see if all has expired.
			# # If it has, then the cache can be removed if nattch = 1
			# $can_remove = 1;
			# foreach my $namespace($self->get_namespaces()) {
				# print $tulip "DEMOLISH: namespace = $namespace\n";
				# foreach my $key($self->get_keys($namespace)) {
					# # May give substr error in CHI
					# print $tulip "DEMOLISH: key = $key\n";
					# if($self->is_valid($key)) {
					# print $tulip "DEMOLISH: is_valid\n";
						# $can_remove = 0;
						# last;
					# }
				# }
			# }
			# $self->shm()->detach();
			# if($can_remove) {
				# $self->shm()->remove();
			# }
		} else {
			$self->shm()->detach();
		}
		$self->_unlock();
		if($can_remove && (my $lock_file = $self->lock_file())) {
			$self->lock_file(undef);
			close $self->lock_fd();
			unlink $lock_file;
			# print $tulip "unlink $lock_file\n";
			# close $tulip;
		}
	}
}

=head1 AUTHOR

Nigel Horne, C<< <njh at bandsman.co.uk> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-chi-driver-sharedmem at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=CHI-Driver-SharedMem>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

Max_size is handled, but if you're not consistent across the calls to each cache,
the results are unpredictable because it's used to create the size of the shared memory
area.

The shm_size argument should be deprecated and only the max_size argument used.

=head1 SEE ALSO

L<CHI>, L<IPC::SharedMem>