view release on metacpan or  search on metacpan

lib/Data/Annotation/Overlay.pm  view on Meta::CPAN

package Data::Annotation::Overlay;
use v5.24;
use utf8;
use Moo;
use experimental qw< signatures >;
use Ouch qw< :trytiny_var >;
use Scalar::Util qw< blessed >;
use Data::Annotation::Traverse qw< :all >;
use namespace::clean;

has under => (is => 'ro', required => 1);
has over  => (is => 'ro', default => sub { return {} });
has traverse_methods => (is => 'ro', default => 1);
has strict_blessed   => (is => 'ro', default => 0);
has method_over_key  => (is => 'ro', default => 1);
has value_if_missing => (is => 'ro', predicate => 1);
has value_if_undef   => (is => 'ro', predicate => 1);
has cache_existing   => (is => 'ro', default => 1);

sub delete ($self, $path) { $self->set($path, MISSING) }

sub get ($self, $path) {
   ouch 400, 'cannot get an undefined path' unless defined($path);
   my $crumbs = crumble($path);
   my $kpath  = kpath($crumbs);

   # retrieve item, first look in the overlay, then go down
   my $retval;
   my $over = $self->over;
   my $under = $self->under;
   my $under_class = blessed($under);
   if (exists($over->{$kpath})) {
      $retval = $over->{$kpath};
   }
   elsif (blessed($under) && $under->isa(__PACKAGE__)) {
      $retval = $under->get($path); # get from previous layer in stack
   }
   else {
      $retval = traverse_plain($under, $crumbs, $self->traversal_options);
      $over->{$kpath} = $retval if $self->cache_existing;
   }

   return $self->return_value_for($retval);
}

# use traversal options and return value massaging
sub get_external ($self, $path, $data) {
   ouch 400, 'cannot get an undefined path' unless defined($path);
   my $crumbs = crumble($path);
   my $retval = traverse_plain($data, $crumbs, $self->traversal_options);
   return $self->return_value_for($retval);
}

sub merged ($self) {
   my %over;
   my $cursor = $self;
   my $any_layer_does_caching = 0;
   while ('necessary') {
      $any_layer_does_caching ||= $cursor->cache_existing;
      %over = ($cursor->over->%*, %over);
      my $under = $cursor->under;
      last unless blessed($under) && $under->isa(__PACKAGE__);
      $cursor = $under;
   }
   # now $cursor points to the bottom of the stack
   return $self->new(
      under            => $cursor->under,
      over             => \%over,
      traverse_methods => $cursor->traverse_methods,
      strict_blessed   => $cursor->strict_blessed,
      method_over_key  => $cursor->method_over_key,
      value_if_missing => $self->value_if_missing,
      value_if_undef   => $self->value_if_undef,
      cache_existing   => $any_layer_does_caching,
   );
}

sub return_value_for ($self, $retval) {
   if (means_missing($retval)) {
      return unless $self->has_value_if_missing;
      return $self->value_if_missing;
   }
   return $retval if defined($retval) || (! $self->has_value_if_undef);
   return $self->value_if_undef;
}

sub set ($self, $path, $value) {