… | |
… | |
895 | # we give our best and fall back to URI if available. |
895 | # we give our best and fall back to URI if available. |
896 | if (exists $hdr{location}) { |
896 | if (exists $hdr{location}) { |
897 | my $loc = $hdr{location}; |
897 | my $loc = $hdr{location}; |
898 | |
898 | |
899 | if ($loc =~ m%^//%) { # // |
899 | if ($loc =~ m%^//%) { # // |
900 | $loc = "$rscheme:$loc"; |
900 | $loc = "$uscheme:$loc"; |
901 | |
901 | |
902 | } elsif ($loc eq "") { |
902 | } elsif ($loc eq "") { |
903 | $loc = $url; |
903 | $loc = $url; |
904 | |
904 | |
905 | } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple" |
905 | } elsif ($loc !~ /^(?: $ | [^:\/?\#]+ : )/x) { # anything "simple" |
906 | $loc =~ s/^\.\/+//; |
906 | $loc =~ s/^\.\/+//; |
907 | |
907 | |
908 | if ($loc !~ m%^[.?#]%) { |
908 | if ($loc !~ m%^[.?#]%) { |
909 | my $prefix = "$rscheme://$uhost:$uport"; |
909 | my $prefix = "$uscheme://$uhost:$uport"; |
910 | |
910 | |
911 | unless ($loc =~ s/^\///) { |
911 | unless ($loc =~ s/^\///) { |
912 | $prefix .= $upath; |
912 | $prefix .= $upath; |
913 | $prefix =~ s/\/[^\/]*$//; |
913 | $prefix =~ s/\/[^\/]*$//; |
914 | } |
914 | } |