view release on metacpan or  search on metacpan

lib/Hash/Layout.pm  view on Meta::CPAN

package Hash::Layout;
use strict;
use warnings;

# ABSTRACT: hashes with predefined layouts, composite keys and default values

our $VERSION = '2.00';

use Moo;
use Types::Standard qw(:all);
use Scalar::Util qw(blessed looks_like_number);
use Hash::Merge::Simple 'merge';
use Clone;
use Text::Glob qw( match_glob );

use Hash::Layout::Level;

has 'levels', is => 'ro', isa => ArrayRef[
  InstanceOf['Hash::Layout::Level']
], required => 1, coerce => \&_coerce_levels_param;

sub num_levels { scalar(@{(shift)->levels}) }

has 'default_value',     is => 'ro',              default => sub { 1 };
has 'default_key',       is => 'ro', isa => Str,  default => sub { '*' };
has 'allow_deep_values', is => 'ro', isa => Bool, default => sub { 1 };
has 'deep_delimiter',    is => 'ro', isa => Str,  default => sub { '.' };
has 'no_fill',           is => 'ro', isa => Bool, default => sub { 0 };
has 'no_pad',            is => 'ro', isa => Bool, default => sub { 0 };
has 'enable_globmatch',  is => 'ro', isa => Bool, default => sub { 0 };

has 'lookup_mode', is => 'rw', isa => Enum[qw(get fallback merge)], 
  default => sub { 'merge' };

has '_Hash', is => 'ro', isa => HashRef, default => sub {{}}, init_arg => undef;
has '_Hash_fq_composite', is => 'ro', isa => HashRef, default => sub {{}}, init_arg => undef;
has '_all_level_keys', is => 'ro', isa => HashRef, default => sub {{}}, init_arg => undef;

# List of bitmasks representing every key path which includes
# a default_key, with each bit representing the level and '1' toggled on
# where the key is the default
has '_def_key_bitmasks', is => 'ro', isa => HashRef, default => sub {{}}, init_arg => undef;

sub Data { Clone::clone( (shift)->_Hash ) }

sub level_keys {
  my ($self, $index) = @_;
  die 'level_keys() expects level index argument' 
    unless (looks_like_number $index);
    
  die "No such level index '$index'" 
    unless ($self->levels->[$index]);

  return $self->_all_level_keys->{$index} || {};
}

# Clears the Hash of any existing data
sub reset {
  my $self = shift;
  %{$self->_Hash}                 = ();
  %{$self->_Hash_fq_composite}    = ();
  %{$self->_all_level_keys}       = ();
  %{$self->_def_key_bitmasks}     = ();
  $self->{_lookup_path_globmatch} = {};
  return $self;
}

sub clone { Clone::clone(shift) }


around BUILDARGS => sub {
  my ($orig, $self, @args) = @_;
  my %opt = (ref($args[0]) eq 'HASH') ? %{ $args[0] } : @args; # <-- arg as hash or hashref
  
  # Accept 'levels' as shorthand numeric value:
  if($opt{levels} && looks_like_number $opt{levels}) {
    my $num = $opt{levels} - 1;
    $opt{delimiter} ||= '/';
    my @levels = ({ delimiter => $opt{delimiter} }) x $num;
    $opt{levels} = [ @levels, {} ];
    delete $opt{delimiter};
  }

  return $self->$orig(%opt);
};


sub BUILD {
  my $self = shift;
  $self->_post_validate;
}

sub _post_validate {
  my $self = shift;

  if($self->allow_deep_values) {
    for my $Lvl (@{$self->levels}) {
      die join("",
        "Level delimiters must be different from the deep_delimiter ('",
          $self->deep_delimiter,"').\n",
        "Please specify a different level delimiter or change 'deep_delimiter'"
      ) if ($Lvl->delimiter && $Lvl->delimiter eq $self->deep_delimiter);