X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FHval.pm;h=2589c519db9e895fb2ddf82ca9212b4749ba10d6;hb=ae469c583c2ddea48b5923af5986753251bf14ca;hp=4a79439f8e27f23f320ed05e288b5d8848150fef;hpb=ecf084d1f59f34f24eefbf0c64159ca96b489f73;p=public-inbox.git diff --git a/lib/PublicInbox/Hval.pm b/lib/PublicInbox/Hval.pm index 4a79439f..2589c519 100644 --- a/lib/PublicInbox/Hval.pm +++ b/lib/PublicInbox/Hval.pm @@ -10,7 +10,7 @@ use Encode qw(find_encoding); use PublicInbox::MID qw/mid_clean mid_escape/; use base qw/Exporter/; our @EXPORT_OK = qw/ascii_html obfuscate_addrs to_filename src_escape - to_attr from_attr/; + to_attr prurl/; my $enc_ascii = find_encoding('us-ascii'); # safe-ish acceptable filename pattern for portability @@ -84,8 +84,15 @@ sub raw { } } -sub prurl { +# returns a protocol-relative URL string +sub prurl ($$) { my ($env, $u) = @_; + if (ref($u) eq 'ARRAY') { + my $h = $env->{HTTP_HOST} // $env->{SERVER_NAME}; + my @host_match = grep(/\b\Q$h\E\b/, @$u); + $u = $host_match[0] // $u->[0]; + # fall through to below: + } index($u, '//') == 0 ? "$env->{'psgi.url_scheme'}:$u" : $u; } @@ -132,22 +139,12 @@ sub to_attr ($) { return if index($str, '//') >= 0; my $first = ''; + utf8::encode($str); # to octets if ($str =~ s/\A([^A-Ya-z])//ms) { # start with a letter $first = sprintf('Z%02x', ord($1)); } $str =~ s/([^A-Za-z0-9_\.\-])/$ESCAPES{$1}/egms; - $first . $str; -} - -# reverse the result of to_attr -sub from_attr ($) { - my ($str) = @_; - my $first = ''; - if ($str =~ s/\AZ([a-f0-9]{2})//ms) { - $first = chr(hex($1)); - } - $str =~ s!::([a-f0-9]{2})!chr(hex($1))!egms; - $str =~ tr!:!/!; + utf8::decode($str); # allow wide chars $first . $str; }