ch-2.pl

#!/usr/bin/env perl
#
use strict;
use warnings;
use v5.26;

my $frag=qr/[\w\d]+/;
my $qval=qr/[\w\d]+/;
my $qkey=qr/[\w\d]+/;
my $qpair=qr/$qkey\=$qval/;
my $query=qr/$qpair(?:\&$qpair)*/;
my $port=qr/\d+/;
my $path=qr/(\/(?:[\w\d\.]+\/?)*)/;
my $host=qr/[\w\d\.]+/;
my $user=qr/[\w\d]+/;
my $pass=qr/[\w\d]+/;
my $auth=qr/\/\/(?:($user)(?:\:($pass))?\@)?($host)(?:\:($port))?/;
my $scheme=qr/([a-z][a-z\-\.\+]+)/;
my $URI='jdbc://user:password@localhost:3306/pwc?profile=true#h1>';
my $match=($ARGV[0]//$URI)=~/$scheme\:$auth?$path(?:\?($query))?(?:\#($frag))?/;
die "Not a URI\n" unless $match;
my @out=( 
	"Scheme: ".($1//""),
	"User: ".($2//""),
	"Password: ".($3//""),
	"Host: ".($4//""),
	"Port: ".($5//""),
	"Path ".($6//""),
	"Query: ".($7//""),
	"Fragment: ".($8//""),
);
print join "\n", @out;