view release on metacpan or  search on metacpan

lib/Banal/Role/Fallback/Tiny.pm  view on Meta::CPAN

#######################################
sub _resolve_href { # Explicitely asks for a hash reference
#######################################
  my  $self     = shift;
  my  $opt    = ( ref ($_[0]) =~ /HASH/ ) ? shift : {};
  $self->_resolve( {  %$opt, want_reftype => 'HASH' }, @_ );
}


# Practical method-helper for determining the effective value to be used for a given attribute for a given object.
# The object would need to satisfy several conditions, though
#######################################
sub _fallback   {
#######################################
  local $_;
  my ($o, %opt)     = &_normalize_fallback_opts;
  my  @keys         = tidy_arrayify( $opt{keys} );
  my  @blankers     = tidy_arrayify( $opt{blanker_token} );
  my  @mid          = tidy_arrayify( @opt{qw( via )});
      @mid          = tidy_arrayify( @opt{qw( mid nrm normally )}, \&_smart_lookup) unless !!@mid;
  my  @attempts     = tidy_arrayify(
                          @opt{qw( apriori primo )},
                          @mid,
                          @opt{qw( def last fin final finally )}
                        );
  my  @res;
  my  $debug         = $opt{debug};

  # say STDERR "Looking up keys : " . np @keys if $debug;
ATTEMPT:
  foreach my $item (@attempts) {
    next unless defined $item;
    my $v = (reftype($item) // '') eq 'CODE'
              ? eval { $item->($o, \%opt) }
              : $item;

    # say STDERR "Attempt died on us : $@"  if $@ && $debug;

    if (defined($v) && !$@) {
      push @res, $v;
      last ATTEMPT;
    }
    eval {; 1 }; # clear the last error
  }

  @res = tidy_arrayify(@res);

  # say STDERR "  Got (raw) : " . np @res if $debug;

  {
    no warnings qw(uninitialized);
    my  @greps   = tidy_arrayify( $opt{grep}, $opt{greps});
    push @greps, sub {; my @v=($_); !intersect(@blankers, @v) } if (@blankers);

    foreach my $f ( @greps ) {
        my  $rt = reftype($f) // '';
        @res =  grep {
                  my $gr = $_;
                  $rt eq 'CODE'   and   $gr  = $f->($_);
                  $rt eq 'REGEXP' and   $gr  = m/$f/;
                  !$rt            and   $gr  = looks_like_number($f) ? ($_ == $f) : ($_ eq "$f");
                  $gr
                }@res;
    }
    @res  = uniq(@res) unless $opt{no_uniq} && !$opt{uniq};
    @res  = sort @res  if $opt{sort};
  }

  # say STDERR "  Keys : " . np @keys if grep { m/install/ } @keys;
  # say STDERR "  Got  : " . np @res  if $debug;

  return [ @res ] if $opt{want_reftype}  eq 'ARRAY' ;
  return          unless @res;   # Got no results at all. Signal that.
  return $res[0]  if @res == 1;  # If we've got only one value, then there is no ambiguity. Just return that.

  if ( $opt{want_reftype}  eq 'HASH' ) {
      my %res = map {; ref ($_) =~ /HASH/ix ? ( %{$_} ) : ()  } reverse @res;      # effectively shallow-merge the resulting hashes
      return +{ %res };
  }

  # At this stage, even if we have more than one value, we only return the first found.
  # CONSIDER: raising an error, perhaps.
  return $res[0];
}

#
# #######################################
# around _fallback =>  sub { # DEBUG wrapper.
# #######################################
#   my  $orig         = shift;
#   my ($o, %opt)     = &_normalize_fallback_opts;
#   my  @keys         = tidy_arrayify( $opt{keys} );
#   my  $debug         = $opt{debug};
#   my  %info         = (keys => [@keys] );
#
#   if (wantarray) {
#     say STDERR "\n\nFallback in ARRAY context for keys [@keys] ... " if $debug;
#     my @r = $o->$orig($o, \%opt, @_);
#     $info{result} = [@r];
#     say STDERR "Fallback in ARRAY context. info : " . np %info if $debug;
#     return @r;
#   } else {
#     say STDERR "\n\nFallback in SCALAR context for keys [@keys] ... " if $debug;
#     my $r = scalar($o->$orig($o, \%opt, @_));
#     $info{result} = $r;
#     say STDERR "   Fallback result in SCALAR context. info : " . np %info if $debug;
#     return $r;
#   }
#
# };
#

#######################################
sub _smart_lookup  {
#######################################
# Returns the first found item (corresponding to any of the given keys) in any of the hash sources.
  local $_;
  my ($o, %opt)     = &_normalize_fallback_opts;
  my  @keys         = tidy_arrayify( $opt{keys} )
                      or   die "No keys given for us to lookup during staged fallback!";
  my  @res;