File Coverage

blib/lib/Object/Releaser.pm

Criterion	Covered	Total	%
statement	27	27	100.0
branch	7	8	87.5
condition			n/a
subroutine	6	6	100.0
pod	3	4	75.0
total	43	45	95.5

package Object::Releaser;
use strict;

# debugging tools
# use Debug::ShowStuff ':all';
# use Debug::ShowStuff::ShowVar;

# version
our $VERSION = '0.12';

=head1 NAME

Object::Releaser -- Remove properties from an object when the releaser goes out of scope.

=head1 SYNOPSIS

Remove all hash reference elements:

 $object = {a=>1, b=>2, c=>3};
 $releaser = Object::Releaser->new($object);
 undef $releaser;
 # object still exists but has no elements

Remove only hash reference elements a and b:

 $object = {a=>1, b=>2, c=>3};
 $releaser = Object::Releaser->new($object);
 $releaser->set_keys(qw{a b});
 undef $releaser;
 # object has element c but not a and b

Cancel the release, don't release anything:

 $object = {a=>1, b=>2, c=>3};
 $releaser = Object::Releaser->new($object);
 $releaser->dismiss();
 undef $releaser;
 # object is not changed

=head1 DESCRIPTION

Object::Releaser provides the ability to delete all or some of the elements
from a hash reference when the releaser goes out of scope.  This is done by
creating the releaser, passing in the object to be released as the sole
argument:

 $releaser = Object::Releaser->new($object);

When $releaser goes out of scope, all elements in $object are deleted.

If you only want specific elements deleted, set those elements with
$releaser->set_keys().  So, for example, the following lines set the releaser
to delete elements a and b from the object, but not any other elements:

 $releaser = Object::Releaser->new($object);
 $releaser->set_keys(qw{a b});

=head1 ALTERNATIVES

Object::Destroyer provides very similar functionality.  It provides for more
complex situations and has greater flexibility.  Object::Releaser fulfills one
simple function: deleting elements from a hashref.

If you just want to avoid circular references, you might want to use weaken in
the Scalar::Util module (which is built into Perl as of version 5.6.0).

=head1 INSTALLATION

Array::OneOf can be installed with the usual routine:

 perl Makefile.PL
 make
 make test
 make install

=head1 METHODS

=cut



#------------------------------------------------------------------------------
# new
#

=head2 new

Creates an Object::Releaser object. The single argument is the object to be
released when $releaser goes out of scope:

 $releaser = Object::Releaser->new($object);

If you do nothing else, then all elements in $object will be deleted when
$releaser goes out of scope.

=cut

sub new {
	my ($class, $object) = @_;
	my $releaser = bless {}, $class;

	# store object
	$releaser->{'object'} = $object;

	# return
	return $releaser;
}
#
# new
#------------------------------------------------------------------------------


#------------------------------------------------------------------------------
# set_keys
#

=head2 set_keys

Tells the releaser to only delete specified keys from the object.  For example,
the code:

 $releaser->set_keys(qw{a b});

sets the releaser so that only elements C and C are deleted.

=cut

sub set_keys {
	my ($releaser, @keys) = @_;
	$releaser->{'keys'} = \@keys;
}
#
# set_keys
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# delete_all
#

=head2 delete_all

C does the opposite of C: it sets the releaser to delete
all keys from the target object.  Use C if you previously used
C to set deletion for specific keys, but now want to go back to
deleting all keys:

 $releaser = Object::Releaser->new($object);
 $releaser->set_keys(qw{a b});
 $releaser->delete_all();

=cut

sub delete_all {
	my ($releaser) = @_;
	delete $releaser->{'keys'};
}
#
# delete_all
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# dismiss
#
sub dismiss {
	my ($releaser, $dismiss) = @_;

	# if $dismiss is defined, use that value
	if (defined $dismiss)
		{ $releaser->{'dismiss'} = $dismiss }

	# else set to true
	else
		{ $releaser->{'dismiss'} = 1 }

	# return
	return $releaser->{'dismiss'};
}
#
# dismiss
#------------------------------------------------------------------------------



#------------------------------------------------------------------------------
# DESTROY
#
sub DESTROY {
	my ($releaser) = @_;
	my $object = $releaser->{'object'};

	# if no object, return
	$object or return;

	# if dismissed, return
	if ($releaser->{'dismiss'})
		{ return }

	# if keys are defined, delete only those keys
	if ($releaser->{'keys'}) {
		foreach my $key (@{$releaser->{'keys'}})
			{ delete $object->{$key} }
	}

	# else release all properties
	else {
		foreach my $key (keys %$object)
			{ delete $object->{$key} }
	}
}
#
# DESTROY
#------------------------------------------------------------------------------



# return true
1;

__END__