X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FHval.pm;h=23233f0e7e979c8ff524e1864a46489a747512c9;hb=78792fee4031aee0a8bd532bff98efc2b9409d68;hp=cd3a4df34bec61bad715fbf1546dec1c74338d2e;hpb=1988d730c0088e8b1f6193650c7ee929df8a2ed7;p=public-inbox.git diff --git a/lib/PublicInbox/Hval.pm b/lib/PublicInbox/Hval.pm index cd3a4df3..23233f0e 100644 --- a/lib/PublicInbox/Hval.pm +++ b/lib/PublicInbox/Hval.pm @@ -1,4 +1,4 @@ -# Copyright (C) 2014-2019 all contributors +# Copyright (C) 2014-2020 all contributors # License: AGPL-3.0+ # # represents a header value in various forms. Used for HTML generation @@ -10,27 +10,13 @@ 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 mid_href/; my $enc_ascii = find_encoding('us-ascii'); # safe-ish acceptable filename pattern for portability our $FN = '[a-zA-Z0-9][a-zA-Z0-9_\-\.]+[a-zA-Z0-9]'; # needs \z anchor -sub new { - my ($class, $raw, $href) = @_; - - # we never care about trailing whitespace - $raw =~ s/\s*\z//; - bless { - raw => $raw, - href => defined $href ? $href : $raw, - }, $class; -} - -sub new_msgid { - my ($class, $msgid) = @_; - $class->new($msgid, mid_escape($msgid)); -} +sub mid_href { ascii_html(mid_escape($_[0])) } # some of these overrides are standard C escapes so they're # easy-to-understand when rendered. @@ -69,22 +55,12 @@ sub src_escape ($) { sub ascii_html { my ($s) = @_; - $s =~ s/\r\n/\n/sg; # fixup bad line endings $s =~ s/([<>&'"\x7f\x00-\x1f])/$xhtml_map{$1}/sge; $enc_ascii->encode($s, Encode::HTMLCREF); } -sub as_html { ascii_html($_[0]->{raw}) } - -sub raw { - if (defined $_[1]) { - $_[0]->{raw} = $_[1]; - } else { - $_[0]->{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}; @@ -102,7 +78,7 @@ sub prurl { # However, • was chosen to make copy+paste errors more obvious sub obfuscate_addrs ($$;$) { my $ibx = $_[0]; - my $repl = $_[2] || '•'; + my $repl = $_[2] // '•'; my $re = $ibx->{-no_obfuscate_re}; # regex of domains my $addrs = $ibx->{-no_obfuscate}; # { adddress => 1 } $_[1] =~ s/(([\w\.\+=\-]+)\@([\w\-]+\.[\w\.\-]+))/ @@ -138,22 +114,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; }