view release on metacpan or  search on metacpan

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

use 5.014;
use utf8;
use strict;
use warnings;

package Banal::Role::Fallback::Tiny;
# vim: set ts=2 sts=2 sw=2 tw=115 et :
# ABSTRACT: A tiny role that provides a 'fallback' method which helps building default values for object attributes.
# KEYWORDS: author utility

our $VERSION = '0.001';
# AUTHORITY

use Banal::Util::Mini   qw(tidy_arrayify hash_lookup_staged sanitize_subroutine_name);
use Array::Utils        qw(intersect);
use Scalar::Util        qw(blessed refaddr reftype);
use List::Util 1.45     qw(any none pairs uniq);
use List::MoreUtils     qw(arrayify firstres listcmp);
use Text::ParseWords    qw(quotewords);
use Data::Printer;

use namespace::autoclean;
use Role::Tiny;
requires qw( _fallback_settings );



#######################################
sub _resolve    {  # Transitional. Helps support an older name & interface to _fallback
#######################################
  my  $o            = shift;
  my  %opt          = %{ ref $_[0] eq 'HASH' ? shift : +{} };
  _fallback($o, { args_are_keys => 1, %opt}, @_)
}

#######################################
sub _resolve_mv { # Explicitely asks for an ARRAY reference.
#######################################
  # Also handles 'implicit additions' (extras that are appended systematically)
  my  $self     = shift;
  my  $opt    = ( ref ($_[0]) =~ /HASH/ ) ? shift : {};
  $self->_resolve( {  %$opt, want_reftype => 'ARRAY', multivalue => 1 }, @_);
}

#######################################
sub _resolve_mv_list {  # Always returns a list, instead of an ARRAY reference.
#######################################
  @{ shift->_resolve_mv(@_) }
}

#######################################
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;