Mixin-ExtraFields
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Mixin/ExtraFields/Driver/HashGuts.pm view on Meta::CPAN
sub hash_key {
my ($self) = @_;
return $self->{hash_key};
}
#pod =head2 default_hash_key
#pod
#pod If no C<hash_key> argument is given for the driver, this method is called
#pod during driver initialization. It will return a unique string to be used as the
#pod hash key.
#pod
#pod =cut
my $i = 0;
sub default_hash_key {
my ($self) = @_;
return "$self" . '@' . $i++;
}
#pod =head2 storage
#pod
#pod This method returns the hashref of storage used for extras. Individual objects
#pod get weak references to their id within this hashref.
#pod
#pod =cut
sub storage { $_[0]->{storage} }
#pod =head2 storage_for
#pod
#pod my $stash = $driver->storage_for($object, $id);
#pod
#pod This method returns the hashref to use to store extras for the given object and
#pod id. This hashref is stored on both the hash-based object (in its C<hash_key>
#pod entry) and on the driver (in the entry for C<$id> in its C<storage> hash).
#pod
#pod All objects with the same id should end up with the same hash in their
#pod C<hash_key> field. B<None> of these references are weakened, which means two
#pod things: first, even if all objects with a given id go out of scope, future
#pod objects with that id will retain the original extras; secondly, memory used to
#pod store extras is never reclaimed. If this is a problem, use a more
#pod sophisticated driver.
#pod
#pod =cut
sub storage_for {
my ($self, $object, $id) = @_;
my $store = $self->storage->{ $id } ||= {};
unless ($object->{ $self->hash_key }||0 == $store) {
$object->{ $self->hash_key } ||= $store;
}
return $store
}
sub from_args {
my ($class, $arg) = @_;
my $self = bless { storage => {} } => $class;
$self->{hash_key} = $arg->{hash_key} || $self->default_hash_key;
return $self;
}
sub exists_extra {
my ($self, $object, $id, $name) = @_;
return exists $self->storage_for($object, $id)->{$name};
}
sub get_extra {
my ($self, $object, $id, $name) = @_;
# avoid autovivifying entries on get.
return unless $self->exists_extra($object, $id, $name);
return $self->storage_for($object, $id)->{$name};
}
sub get_detailed_extra {
my ($self, $object, $id, $name) = @_;
# avoid autovivifying entries on get.
return unless $self->exists_extra($object, $id, $name);
return { value => $self->storage_for($object, $id)->{$name} };
}
sub get_all_detailed_extra {
my ($self, $object, $id) = @_;
my $stash = $self->storage_for($object, $id);
my @all_detailed = map { $_ => { value => $stash->{$_} } } keys %$stash;
}
sub get_all_extra {
my ($self, $object, $id) = @_;
return %{ $self->storage_for($object, $id) };
}
sub set_extra {
my ($self, $object, $id, $name, $value) = @_;
$self->storage_for($object, $id)->{$name} = $value;
}
sub delete_extra {
my ($self, $object, $id, $name) = @_;
delete $self->storage_for($object, $id)->{$name};
}
sub delete_all_extra {
my ($self, $object, $id) = @_;
%{ $self->storage_for($object, $id) } = ();
}
1;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.900 second using v1.00-cache-2.02-grep-82fe00e-cpan-503542c4f10 )