File Coverage

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

Criterion	Covered	Total	%
statement	41	42	97.6
branch	11	14	78.5
condition	7	10	70.0
subroutine	9	9	100.0
pod	1	1	100.0
total	69	76	90.7

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


use v5.14;
use warnings;

package Protocol::Sys::Virt::URI v12.5.1;

use parent qw(Exporter);

use Carp qw(croak);
use List::Util qw(pairmap);
use Log::Any qw($log);
use URI::Encode qw(uri_encode uri_decode);

our @EXPORT = qw( parse_url );

sub parse_url {
    my $url = shift;
    my ($base, $query) = split( /\?/, $url, 2 );
    $query //= '';
    my %args;
    pairmap {
        if ($a eq 'argv') {
            if (exists $args{argv}) {
                push $args{argv}->@*, $b;
            }
            else {
                $args{argv} = [ $b ];
            }
        }
        else {
            $args{$a} = $b;
        }
    }
    map {
        uri_decode($_)
    }
    map {
        my ($key, $val) = split( /=/, $_, 2 );
        $val //= '';
        ($key, $val);
    }
    split( /&/, $query );

    if ($base =~ m#^
                (?[a-z0-9_]+)
                (?:\+(?[a-z0-9_]+))?
                ://
                (?:(?[^@]+)@)?
                ((?[a-z0-9_\-\.]+)
                 (?:\:(?\d+))?
                )?
                /
                (?system|session)
                $
                #xi) {
        my $bare = "$+{hypervisor}:///$+{type}";
        $bare .= '?' if ($args{mode} or $args{socket});
        $bare .= 'mode=' . uri_encode($args{mode},
                                      { encode_reserved => 1 })
            if $args{mode};
        $bare .= '&' if ($args{mode} and $args{socket});
        $bare .= 'socket=' . uri_encode($args{socket},
                                        { encode_reserved => 1 })
            if $args{socket};
        return (base => $base,
                proxy => $bare,
                name => "$+{hypervisor}:///$+{type}",
                %+,
                query => \%args);
    }

    die "Malformed hypervisor URI $url";
}

1;


__END__