trunk/clients/perl/OpenXPKI-Client-HTML-Mason/htdocs/lib/url.mhtml

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