#!/usr/bin/perl -w
use strict;

# for parsing URL's like:
# "http://www.linuxquestions.org:8080/forums/search.cgi?string=help#me"

# will parse if ALL parts are there, but the problem is getting the input into the array
# when not all parts are there.

# declare variables

my ($proto, $host, $port, $path, $query, $frag);
$proto    = '(\w*)';
$host     = '([\w\.]*)';
$port     = ':(\d*)';
$path     = '([\w/\.]*)';
$query    = '\?([\w=]*)';
$frag     = '#(\w*)';


print ("\nEnter a URL to parse\n");

while(<STDIN>){
    chomp;
    my $url = "${proto}://${host}${port}?${path}${query}?${frag}?";
    my @answers =  m|$url|;

    # protocol and host are compulsory
    print("Protocol = $answers[0]\n");
    print("Host = $answers[1]\n");

    if(defined($answers[2])){ print("Port = $answers[2]\n"); }
    if(defined($answers[3])){ print("Path = $answers[3]\n"); }
    if(defined($answers[4])){ print("Query = $answers[4]\n"); }
    if(defined($answers[5])){ print("Fragment  = $answers[5]\n"); }
}

if ( $url =~ m/^(\w+:\/\/)?(\w*)?(:\w*)?@?([\w.]+)*(:\d*)?(\/\w*)?$/ )
{

	if(defined($1))
	{
		$db_proto = $1;
	}
	
	if(defined($2))
	{
		$db_user = $2;
	}
	
	if(defined($3))
	{
		$3 =~ m/^:(\w+)$/;
		$db_pass = $1;
	}
	
	if(defined($4))
	{
		$db_host = $4;
	}
	
	if(defined($5))
	{
		$5 =~ m/^:(\d+)$/;
		$db_port = $1;
	}
	
	if(defined($6))
	{
		$6 =~ m/^\/(\w+)$/;
		$db_name = $1;
	}

http://user:password@server:1234/database