# Selima Website Content Management System # RelURI.pm: The converter to turn all URIs to relative URIs. # Copyright (c) 2003-2018 imacat. # # Licensed under the Apache License, Version 2.0 (the "License"); # you may not use this file except in compliance with the License. # You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # Author: imacat # First written: 2003-04-03 package Selima::RelURI; use 5.008; use strict; use warnings; use base qw(Exporter); use vars qw(@EXPORT @EXPORT_OK); BEGIN { @EXPORT = qw(reluri); @EXPORT_OK = @EXPORT; # Prototype declaration sub reluri($;$); } use Encode qw(encode decode is_utf8); use URI qw(); use Selima::DataVars qw(:requri); # reluri: Turn an absolute URI to a relative URI sub reluri($;$) { local ($_, %_); my ($uri, $base, $encoded); ($uri, $base) = @_; # URI has bug with encode(). We get around it here. $encoded = 0; if (is_utf8($uri)) { $uri = encode("UTF-8", $uri); $encoded = 1; } # Default base to $REQUEST_FULLURI $base = defined $base? ($base =~ /^\//? new URI($REQUEST_HOSTPORT . $base): new URI($base)): new URI($REQUEST_FULLURI); # Absolute path -- add the root difference and absolute it if ($uri =~ /^\//) { $uri = "$ROOT_DIFF$uri" ; $uri = new URI($uri); $uri = $uri->abs($REQUEST_FULLURI); } else { $uri = new URI($uri); } # Obtain the relative URI $uri = $uri->rel($base); $uri = $uri->canonical->as_string; # Fix it for my own style $uri =~ s/\/$// if $uri =~ /(?