view release on metacpan or  search on metacpan

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

            write_as/) {
        $self->{$_} = delete $args{$_} if defined $args{$_};
    }

    if ($args{replace}) {
        $self->{replace} = delete $args{replace};
        my $old = $self->_fetch_no_check;
        if (defined $old) {
            my $new = $self->apply_replace($old);
            $self->_store_value($new);
        }
    }

    $self->set_help( \%args );
    $self->set_update( \%args );
    $self->set_value_type( \%args );
    $self->set_default( \%args );
    $self->set_convert( \%args ) if defined $args{convert};
    $self->setup_match_regexp( match => \%args ) if defined $args{match};
    foreach (qw/warn_if_match warn_unless_match/) {
        $self->check_validation_regexp( $_ => \%args ) if defined $args{$_};
    }
    $self->setup_grammar_check( \%args ) if defined $args{grammar};

    # cannot be warped
    $self->set_migrate_from( \%args ) if defined $args{migrate_from};

    Config::Model::Exception::Model->throw(
        object => $self,
        error  => "write_as is allowed only with boolean values"
    ) if defined $self->{write_as} and $self->{value_type} ne 'boolean';

    Config::Model::Exception::Model->throw(
        object => $self,
        error  => "Unexpected parameters: " . join( ' ', each %args ) ) if scalar keys %args;

    if ( $self->has_warped_slaves ) {
        my $value = $self->_fetch_no_check;
        $self->trigger_warp($value);
    }

    # when properties are changed, a check is required to validate new constraints
    $self->needs_check(1);

    return $self;
}

# simple but may be overridden
sub set_help ($self, $args) {
    return unless defined $args->{help};
    $self->{help} = delete $args->{help};
    return;
}

sub set_update ($self, $args) {
    return unless defined $args->{update};
    $self->{update} = delete $args->{update};
    return;
}

sub update_from_file ($self) {
    return unless defined $self->update;

    my $v = $self->get_update_value;
    if (defined $v) {
        $user_logger->info("Updating ". $self->location. " value from file");
        $self->store($v);
        # tell caller that something was done. User logger provides the details
        return '';
    }
    return;
}

# this code is somewhat dead as warping value_type is no longer supported
# but it may come back.
sub set_value_type {
    my ( $self, $arg_ref ) = @_;

    my $value_type = delete $arg_ref->{value_type} || $self->value_type;

    Config::Model::Exception::Model->throw(
        object => $self,
        error  => "Value set: undefined value_type"
    ) unless defined $value_type;

    $self->{value_type} = $value_type;

    if ( $value_type eq 'boolean' ) {

        # convert any value to boolean
        $self->{data}    = $self->{data}    ? 1 : 0 if defined $self->{data};
        $self->{preset}  = $self->{preset}  ? 1 : 0 if defined $self->{preset};
        $self->{layered} = $self->{layered} ? 1 : 0 if defined $self->{layered};
    }
    elsif ($value_type eq 'reference'
        or $value_type eq 'enum' ) {
        my $choice = delete $arg_ref->{choice};
        $self->setup_enum_choice($choice) if defined $choice;
    }
    elsif (any {$value_type eq $_} qw/string integer number uniline file dir/ ) {
        Config::Model::Exception::Model->throw(
            object => $self,
            error  => "'choice' parameter forbidden with type " . $value_type
        ) if defined $arg_ref->{choice};
    }
    else {
        my $msg =
              "Unexpected value type : '$value_type' "
            . "expected 'boolean', 'enum', 'uniline', 'string' or 'integer'."
            . "Value type can also be set up with a warp relation";
        Config::Model::Exception::Model->throw( object => $self, error => $msg )
            unless defined $self->{warp};
    }
    return;
}


sub submit_to_refer_to {
    my $self = shift;

    if ( defined $self->{refer_to} ) {