File Coverage

blib/lib/Protocol/Sys/Virt/TypedParams.pm

Criterion	Covered	Total	%
statement	72	88	81.8
branch	18	22	81.8
condition			n/a
subroutine	15	21	71.4
pod	13	13	100.0
total	118	144	81.9

####################################################################
#
#     This file was generated using XDR::Parse version v1.0.1
#                   and LibVirt version v12.1.0
#
#      Don't edit this file, use the source template instead
#
#                 ANY CHANGES HERE WILL BE LOST !
#
####################################################################


use v5.14.1;
use warnings;
use Syntax::Operator::Elem qw( elem_str );

package Protocol::Sys::Virt::TypedParams v12.1.0;


use Carp qw(croak);
use Exporter 'import';
use Log::Any qw($log);

# copied from Protocol::Sys::Virt::Remote::XDR, with VIR_ prefix stripped
use constant {
    TYPED_PARAM_INT     => 1,
    TYPED_PARAM_UINT    => 2,
    TYPED_PARAM_LLONG   => 3,
    TYPED_PARAM_ULLONG  => 4,
    TYPED_PARAM_DOUBLE  => 5,
    TYPED_PARAM_BOOLEAN => 6,
    TYPED_PARAM_STRING  => 7,
};

my %value_field_name = (
    1 => 'i',
    2 => 'ui',
    3 => 'l',
    4 => 'ul',
    5 => 'd',
    6 => 'b',
    7 => 's'
    );


our @EXPORT = qw(
    typed_params_new
    typed_field_new
    typed_value_new

    typed_params_check_fields_only
    typed_params_field
    typed_params_fields

    typed_params_field_int_value
    typed_params_field_uint_value
    typed_params_field_long_value
    typed_params_field_ulong_value
    typed_params_field_double_value
    typed_params_field_boolean_value
    typed_params_field_string_value

    TYPED_PARAM_INT
    TYPED_PARAM_UINT
    TYPED_PARAM_LLONG
    TYPED_PARAM_ULLONG
    TYPED_PARAM_DOUBLE
    TYPED_PARAM_BOOLEAN
    TYPED_PARAM_STRING

    );


sub typed_params_check_fields_only {
    my ( $params, @fields ) = @_;

    for my $param (@{ $params }) {
        unless (elem_str( $param->{field}, @fields )) {
            croak "Unexpected parameter $param->{field}";
        }
    }
    return 1;
}

sub typed_params_field {
    my ( $params, $name, @rest ) = @_;
    return unless $params;

    for my $param (@{ $params }) {
        next unless $param->{field} eq $name;

        if (@rest) {
            my $new_entry = shift @rest;
            $param = { field => $name, value => $new_entry };
            return $param;
        }
        return $param;
    }
    if (@rest) {
        my $new_entry = shift @rest;
        my $param = { field => $name, value => $new_entry };
        push @{ $params }, $param;
        return $param;
    }
    return undef;
}

sub typed_params_fields {
    my ( $params, $name ) = @_;
    return [ grep { $_->{field} eq $name } @{ $params } ];
}

sub typed_value_new {
    my ( $type, $value ) = @_;
    return { type => $type, $value_field_name{$type} => $value };
}

sub typed_field_new {
    my ( $name, $value ) = @_;
    return { field => $name, value => $value };
}

sub typed_params_new {
    my ( $from ) = @_;
    $from = [] unless $from;

    return [ map { { %{ $_ } } } @{ $from } ];
}

sub _typed_params_field_value {
    my ( $params, $name, $type, @rest ) = @_;
    return unless $params;

    for my $param (@{ $params }) {
        next unless $param->{field} eq $name;
        croak "TypedParam type mismatch: expected $type, found $param->{value}->{type}"
            if $type != $param->{value}->{type};

        if (@rest) {
            my $new_value = shift @rest;
            $param = {
                field => $name,
                value => {
                    type => $type,
                    $value_field_name{$type} => $new_value }
            };
            return $new_value;
        }

        return $param->{value}->{$value_field_name{$type}};
    }

    if (@rest) {
        my $new_value = shift @rest;
        push @{ $params }, {
            field => $name,
            value => {
                type => $type,
                $value_field_name{$type} => $new_value }
        };

        return $new_value;
    }

    return undef;
}

sub typed_params_field_int_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_INT, @rest );
}

sub typed_params_field_uint_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_UINT, @rest );
}

sub typed_params_field_long_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_LLONG, @rest );
}

sub typed_params_field_ulong_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_ULLONG, @rest );
}

sub typed_params_field_double_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_DOUBLE, @rest );
}

sub typed_params_field_boolean_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_BOOLEAN, @rest );
}

sub typed_params_field_string_value {
    my ( $params, $name, @rest ) = @_;
    return _typed_params_field_value( $params, $name, TYPED_PARAM_STRING, @rest );
}



1;

__END__