view release on metacpan or  search on metacpan

lib/Config/Model/AnyId.pm  view on Meta::CPAN

enum 'DataMode' => [qw/preset layered normal/];

has data_mode => (
    is      => 'rw',
    isa     => 'HashRef[DataMode]',
    traits  => ['Hash'],
    handles => {
        get_data_mode    => 'get',
        set_data_mode    => 'set',
        delete_data_mode => 'delete',
        clear_data_mode  => 'clear',
    },
    default => sub { {}; }
);

# this is cleared and set by set_properties
has _warpable_check_content_actions => (
    is      => 'bare', # no direct accessor
    isa     => 'ArrayRef[CodeRef]',
    traits  => ['Array'],
    handles => {
        add_warpable_check_content   => 'push',
        clear_warpable_check_content => 'clear',
        get_all_warpable_content_checks => 'elements',
    },
    default => sub { []; }
);

has _check_content_actions => (
    is      => 'bare', # no direct accessor
    isa     => 'ArrayRef[CodeRef]',
    traits  => ['Array'],
    handles => {
        add_check_content   => 'push',
        get_all_content_checks => 'elements',
    },
    default => sub { []; }
);

# needs_content_check defaults to 1 to trap bad data right after loading
has needs_content_check => ( is => 'rw', isa => 'Bool', default => 1 );

has has_fixes => (
    is => 'ro',
    isa => 'Num',
    default => 0,
    traits => ['Number'],
    handles => {
        inc_fixes =>   [ add => 1 ],
        dec_fixes =>   [ sub => 1 ],
        add_fixes => 'add',
        flush_fixes => [ mul => 0 ],
    }
);

# Some idea for improvement

# suggest => 'foo' or '$bar foo'
# creates a method analog to next_id (or next_id but I need to change
# run_user_command) that suggest the next id as foo_<nb> where
# nb is incremented each time, or compute the passed formula
# and performs the same

my @common_int_params = qw/min_index max_index max_nb auto_create_ids/;
has \@common_int_params => ( is => 'ro', isa => 'Maybe[Int]' );

my @common_hash_params = qw/default_with_init/;
has \@common_hash_params => ( is => 'ro', isa => 'Maybe[HashRef]' );

my @common_list_params = qw/allow_keys default_keys auto_create_keys/;
has \@common_list_params => (
    is => 'ro',
    isa => 'KeyArray',
    coerce => 1,
    default => sub { []; }
);

my @common_str_params = qw/allow_keys_from allow_keys_matching follow_keys_from
    migrate_keys_from migrate_values_from
    duplicates warn_if_key_match warn_unless_key_match/;
has \@common_str_params => ( is => 'ro', isa => 'Maybe[Str]' );

my @common_params =
    ( @common_int_params, @common_str_params, @common_list_params, @common_hash_params );
my @allowed_warp_params = ( @common_params, qw/level convert/ );

around BUILDARGS => sub {
    my $orig  = shift;
    my $class = shift;
    my %args  = @_;
    my %h     = map { ( $_ => $args{$_} ); } grep { defined $args{$_} } @allowed_warp_params;
    return $class->$orig( backup => dclone( \%h ), @_ );
};

has [qw/backup cargo/] => ( is => 'ro', isa => 'HashRef', required => 1 );
has warp => ( is => 'ro', isa => 'Maybe[HashRef]' );
has [qw/morph/] => ( is => 'ro', isa => 'Bool', default => 0 );
has content_warning_list => ( is => 'rw', isa => 'ArrayRef', default => sub { []; } );
has [qw/cargo_class max_index index_class index_type/] =>
    ( is => 'rw', isa => 'Maybe[Str]' );

has config_model => (
    is       => 'ro',
    isa      => 'Config::Model',
    weak_ref => 1,
    lazy     => 1,
    builder  => '_config_model'
);

sub _config_model {
    my $self = shift;
    return $self->instance->config_model;
}

sub config_class_name {
    my $self = shift;
    return $self->cargo->{config_class_name};
}

sub BUILD {
    my $self = shift;