blob: b0b1e2c5927df96c99132c607aed6f65f6ca3258 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
|
#!/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;
|
