<%doc>
############################################################################
###    (C)opyright 2003 - 2008 RIPE NCC
###    This file is part of DNSMon
###
###    DNSMon is free software: you can redistribute it and/or modify
###    it under the terms of the GNU General Public License as published by
###    the Free Software Foundation, either version 3 of the License, or
###    (at your option) any later version.
###
###    DNSMon is distributed in the hope that it will be useful,
###    but WITHOUT ANY WARRANTY; without even the implied warranty of
###    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
###    GNU General Public License for more details.
###
###    You should have received a copy of the GNU General Public License
###    along with DNSMon.  If not, see <http://www.gnu.org/licenses/>.
############################################################################

Usually I just call this with path and/or query args since I only ever
use it for relative links in the lirportal. But it seems that it could
also be used to create links to other sites and/or other protocols.
Hence that 'if ($host) {' line at the start of the component.

Also, I hacked it here by adding the else statement to prepend the
htdoc stem to all the url's created in the lirportal to save me from
having to hard code it. Perhaps a better solution would have been to
create another component that did that before calling this script.
</%doc>
<%args>
	$scheme   => 'http'
	$username => undef
	$password => ''
	$host     => undef
	$port     => undef
	$path
	%query    => ()
	$fragment => undef
	$stem => undef
</%args>
<%init>
	my $uri = URI->new;

	if ($host) {
		$uri->scheme($scheme);

		if (defined $username) {
			$uri->authority( "$username:$password" );
		}

		$uri->host($host);
		$uri->port($port) if $port;
	}
	else {

		# KAB Hack Start
		if ($stem) {

			# convert absolute paths to document root at /$stem , but only
			# if it hasn't already been done.
			# TODO: can I do this in a oneline sub?
			# TODO: document this better
			# TODO: research conditions under which you don't want to do this.
			if ($path =~ m|^/| and $path !~ m|^/$stem/|o) {
				$path = "/$stem$path";
			}
		}

		# KAB Hack End
	}

	# Sometimes we may want to put a path in a query string but the URI
	# module will escape the question mark.
	my $q;

	if ( $path =~ s/\?(.*)$// ) {
		$q = $1;
	}

	$uri->path($path);

	# If there was a query string, we integrate it into the query
	# parameter.
	if ($q) {
		%query = ( %query, split /[;&=]/, $q );
	}

	# $uri->query_form doesn't handle hash ref values properly
	while ( my ( $key, $value ) = each %query ) {
		$query{$key} = ref $value eq 'HASH' ? [ %$value ] : $value;
	}

	$uri->query_form(%query) if %query;

	$uri->fragment($fragment) if $fragment;

	# replace '&' with ';' as per HTML 4.01 recommendation
	# about Ampersands in URI attribute values
	my $canonical = $uri->canonical;
	$canonical =~ tr/&/;/;
</%init>
<% $canonical | n %>\
