#!/usr/bin/perl

sub dburlparse() {
	my $dburl = shift;
	my $o = {}; # empty array
	$o->{status} = 0;
	# scheme://[[user[:password]@][host][:port]][/[database[/[table|view[/[column[,column...]*]]]]]]
	if ($dburl =~ m!
		^
		((pgsql|mysql)s?)	# scheme maybe SSL (pgsqls)
		://	# URL identifier - required
		(([-a-z0-9_]+)(:([^@]*))?\@)?	# user:pass
		(
			([a-z0-9]+(-+[a-z0-9]+)*)	# localhost | example
		|
			(([a-z0-9]+(-+[a-z0-9]+)*\.)?	# example.com
				([a-z0-9]+(-+[a-z0-9]+)*\.)+([a-z]{2,7})\.?)
		|
			# IP number
			(25[0-5]|2[0-4][0-9]|[0-1][0-9]{2}|[0-9][0-9]|[0-9])\.
			(25[0-5]|2[0-4][0-9]|[0-1][0-9]{2}|[0-9][0-9]|[0-9])\.
			(25[0-5]|2[0-4][0-9]|[0-1][0-9]{2}|[0-9][0-9]|[0-9])\.
			(25[0-5]|2[0-4][0-9]|[0-1][0-9]{2}|[0-9][0-9]|[0-9])
		)?
		(:(\d{1,5}))?	# port
		(/
			(
				(([a-z0-9_]+)	# database
					(/
						(
							(([a-z0-9_]+)		# table
                          					(/
			                     				(([a-z0-9_]+)
					                         		(,[a-z0-9_]+)*
								        )?	# columns
					                        )?
							)|(
								[^ ]+ .+	# SQL
							)?
						)?
					)?
				)?
			)?
		)?
		$!xi) {
		#print map { "$_: ".  (eval "\$$_"). "\n" } (1..40);

		$o->{status} = 1;
		$o->{scheme} = $1;
		$o->{user} = $4;
		$o->{password} = $6;
		$o->{host} = $7;
		$o->{port} = $21;
		$o->{database} = $25;
		$o->{table} = $29;
		$o->{column} = $31;
		$o->{sql} = $34;
	}
	return $o;
}

1;
