www.openxpki.org/trunk/src/lib/url.mas

   1 <%args>
   2    $scheme   => 'http'
   3    $username => undef
   4    $password => ''
   5    $host     => undef
   6    $port     => undef
   7    $path
   8    %query    => ( )
   9    $fragment => undef
  10    $relative => 1
  11 </%args>
  12 <%init>
  13    my $uri = URI->new;
  14
  15    if ($host) {
  16       $uri->scheme($scheme);
  17
  18       if (defined $username) {
  19         $uri->authority( "$username:$password" );
  20       }
  21
  22       $uri->host($host);
  23       $uri->port($port) if $port;
  24    }
  25    elsif (defined $relative && $relative)
  26    {
  27        # this is a local link and conversion from absolute to relative
  28        # links is desired
  29
  30        # original component path (e. g. 'htdocs/news/index.html')
  31        my @caller_path = File::Spec->splitdir($m->request_comp()->path());
  32
  33        # remove target directory portion
  34        # e. g. ('news', 'index.html')
  35        shift @caller_path;
  36        shift @caller_path;
  37
  38        # remove filename portion
  39        # e. g. 'news'
  40        pop @caller_path;
  41
  42        my $caller_dir = File::Spec->catfile("", @caller_path);
  43        $caller_dir = "/" if ($caller_dir eq "");
  44
  45        $path = File::Spec->abs2rel($path, $caller_dir);
  46
  47        $path = "." if ($path eq "");
  48    }
  49
  50    # Sometimes we may want to path in a query string
  51    # but the URI module will escape the question mark.
  52    my $q;
  53
  54    if ( $path =~ s/\?(.*)$// ) {
  55       $q = $1;
  56    }
  57
  58    $uri->path($path);
  59
  60    # If there was a query string, we integrate it into the query
  61    # parameter.
  62    if ($q) {
  63       %query = ( %query, split /[&=]/, $q );
  64    }
  65
  66    # $uri->query_form doesn't handle hash ref values properly
  67    while ( my ( $key, $value ) = each %query ) {
  68       $query{$key} = ref $value eq 'HASH' ? [ %$value ] : $value;
  69    }
  70
  71    $uri->query_form(%query) if %query;
  72
  73    $uri->fragment($fragment) if $fragment;
  74 </%init>
  75 <% $uri->canonical | n %>\