view release on metacpan or  search on metacpan

lib/Class/Simple/Readonly/Cached.pm  view on Meta::CPAN

=head3 API SPECIFICATION

    # Input  None
    # Output { type => 'hashref',
    #          keys => { hits   => 'hashref|undef',
    #                    misses => 'hashref|undef' } }

=head3 MESSAGES

    (none)

=cut

sub state
{
	my $self = shift;
	return { hits => $self->{_hits}, misses => $self->{_misses} };
}

=head2 can

Report whether the inner object (or this class) can respond to a
given method.  Overrides C<UNIVERSAL::can> to account for the
decorator pattern.

=head3 Returns

A code reference if the method exists, C<undef> otherwise.

=head3 EXAMPLE

    my $code = $cached->can('compute');
    $code->($cached) if $code;

=head3 API SPECIFICATION

    # Input  { self   => { type => 'object|string' },
    #          method => { type => 'string' } }
    # Output { type => 'coderef|undef' }

=head3 MESSAGES

    (none)

=cut

sub can
{
	my ($self, $method) = @_;

	# Premise: 'new' belongs to the wrapper, not to the inner object.
	# Conclusion: short-circuit before any object check is needed.
	return \&new if $method eq 'new';

	# Premise: if $self is not a ref (class-level call) OR the inner object
	#          has been freed (global destruction), there is no object to delegate to.
	# Conclusion: fall back to UNIVERSAL for what this package directly provides.
	return $self->SUPER::can($method)
		if !ref($self) || !ref($self->{object});

	# Premise: $self->{object} is alive and is a valid reference (Invariant I4).
	# Conclusion: delegate to the inner object first; fall back to UNIVERSAL.
	return $self->{object}->can($method) // $self->SUPER::can($method);
}

=head2 isa

Test class membership, delegating to the inner object's class
hierarchy when needed.  Overrides C<UNIVERSAL::isa> to support the
transparent decorator pattern.

=head3 Returns

True if the wrapper or its inner object is-a C<$class>.

=head3 EXAMPLE

    $cached->isa('My::Domain::Object');   # true if inner object is

=head3 API SPECIFICATION

    # Input  { self  => { type => 'object|string' },
    #          class => { type => 'string' } }
    # Output { type => 'bool' }

=head3 MESSAGES

    (none)

=cut

sub isa
{
	my ($self, $class) = @_;

	# Fast-path guards that do not require examining the inner object.
	#
	# Premise 1: $class eq ref($self) is logically subsumed by SUPER::isa,
	#   which also returns true for an exact class match -- but the string
	#   equality check is O(1) and avoids the UNIVERSAL dispatch overhead.
	#   Keeping it as a fast path is a valid micro-optimisation, NOT dead code.
	# Premise 2: $class eq __PACKAGE__ handles the subclass case:
	#   a My::Cached instance asked isa('Class::Simple::Readonly::Cached').
	# Premise 3: $class eq 'Class::Simple' is required because @ISA is
	#   intentionally empty; SUPER::isa would return false without this.
	# Premise 4: SUPER::isa covers the full UNIVERSAL hierarchy.
	# Conclusion: any of these makes the wrapper itself a member of $class.
	return 1 if $class eq ref($self)
	          || $class eq __PACKAGE__
	          || $class eq 'Class::Simple'
	          || $self->SUPER::isa($class);

	# Premise: none of the wrapper-level checks matched.
	# Premise: $self->{object} may be freed during global destruction; guard
	#          with ref() before delegating.
	# Conclusion: isa is true iff the inner object claims it.
	return !!(ref($self) && ref($self->{object}) && $self->{object}->isa($class));
}

# _build_cache_accessors -- install backend-specific _get/_set closures on $self.
# The cache backend (HASH vs CHI) is fixed for a wrapper's lifetime.