view release on metacpan or  search on metacpan

lib/Banal/Moosy/Mungers/DeviseFallbacks.pm  view on Meta::CPAN

use 5.014;  # because we use the 'non-destructive substitution' feature (s///r)
use strict;
use warnings;

package Banal::Moosy::Mungers::DeviseFallbacks;
# vim: set ts=2 sts=2 sw=2 tw=115 et :
# ABSTRACT: Provide several MUNGER functions that may be use in conjunction with C<MooseX::MungeHas>.
# KEYWORDS: Munge Has has MungeHas MooseX::MungeHas Moose MooseX Moo MooX

our $VERSION = '0.002';
# AUTHORITY

use Data::Printer;    # DEBUG purposes.
use Scalar::Util      qw(reftype);
use List::Util 1.45   qw(pairs);

use Banal::Util::Mini qw(peek tidy_arrayify);

use namespace::autoclean;
use Exporter::Shiny qw( mhs_fallbacks );


#######################################
sub mhs_fallbacks { # Munge attr specs so that the attribute may use a 'fallback' routine for its 'default' sub.
#######################################
  # ATTENTION : Special calling convention and interface defined by MooseX::MungeHas.
  my $name    = $_;         # $_ contains the attribute NAME
  %_          = (@_, %_);   # %_ contains the attribute SPECS, whereas @_ contains defaults (prefs) for those specs.

  # say STDERR 'Fallback munger : about to start munging : ...';

  # Initial determination of some key properties involving fallback setup.
  my  $fbo_detected       = exists  $_{fallback};
  my  %fbo                = %{ delete( $_{fallback}    ) // +{} };
  my  $disabled           =    delete( $_{no_fallback} ) // peek(\%fbo, [qw(disable disabled)], 0) // 0;

  # Grok some properties (either directly from the 'has' parameters (%_), or from the 'fallback' hash (%fbo)
  my %mappings = (
    # Aliases
    alias   => [qw(aka alias aliases) ],

    #Actual fallback routines or values
    apriori => [qw(apriori primo)     ],
    mid     => [qw(mid nrm normally)  ],
    final   => [qw(def last fin final finally)  ],
    via     => [qw(via)               ],


    # Fallback source specifiers
    author_specific   => [ map {; ($_, 'lookup_' . $_ ) } qw(author author_specific author_prefs author_specific_prefs author_defaults author_settings)  ],

    # Special handling
    no_implicit         => [qw(no_implicit)           ],
    blanker_token       => [qw(blanker blankers blanker_token blanker_tokens ) ],
    implicit_suffix     => [qw(implicit_suffix implicit_suffixes  implicit_suffices implicit_sfx ) ],

    # wants
    multivalue          => [qw(multivalue)           ],

    # Processing to be done on the result
    grep                => [qw(grep greps filter filters)  ],
    sort                => [qw(sort)  ],
    uniq                => [qw(uniq unique)  ],
    no_uniq             => [qw(no_uniq no_unique)  ],
  );

  #say STDERR 'Fallback munger : about to start groking SETTINGS : ...';

SETTING:
  while ( my ($k, $v) = (each %mappings) ) {
    my @eqv = tidy_arrayify($v);
    next SETTING if !@eqv;

    my @array = ();
HASH:
    foreach my $h (\%fbo, \%_) {
      foreach my $e (@eqv) {   #(grep {; $_ ne $k }(@eqv)) {
        push @array, tidy_arrayify( delete($h->{$e}) ) if exists $h->{$e};
      }