diff options
Diffstat (limited to 'lib/PublicInbox/Hval.pm')
-rw-r--r-- | lib/PublicInbox/Hval.pm | 29 |
1 files changed, 24 insertions, 5 deletions
diff --git a/lib/PublicInbox/Hval.pm b/lib/PublicInbox/Hval.pm index 00b3c8b4..963dbb71 100644 --- a/lib/PublicInbox/Hval.pm +++ b/lib/PublicInbox/Hval.pm @@ -4,15 +4,16 @@ # represents a header value in various forms. Used for HTML generation # in our web interface(s) package PublicInbox::Hval; +use v5.10.1; # be careful about unicode_strings in v5.12; use strict; -use warnings; 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 prurl mid_href fmt_ts ts2str/; + to_attr prurl mid_href fmt_ts ts2str utf8_maybe/; use POSIX qw(strftime); my $enc_ascii = find_encoding('us-ascii'); +use File::Spec; # safe-ish acceptable filename pattern for portability our $FN = '[a-zA-Z0-9][a-zA-Z0-9_\-\.]+[a-zA-Z0-9]'; # needs \z anchor @@ -69,7 +70,16 @@ sub prurl ($$) { $u = $host_match[0] // $u->[0]; # fall through to below: } - index($u, '//') == 0 ? "$env->{'psgi.url_scheme'}:$u" : $u; + my $dslash = index($u, '//'); + if ($dslash == 0) { + "$env->{'psgi.url_scheme'}:$u" + } elsif ($dslash < 0 && substr($u, 0, 1) ne '/' && + substr(my $path = $env->{PATH_INFO}, 0, 1) eq '/') { + # this won't touch the FS at all: + File::Spec->abs2rel("/$u", $path); + } else { + $u; + } } # for misguided people who believe in this stuff, give them a @@ -118,7 +128,7 @@ $ESCAPES{'/'} = ':'; # common sub to_attr ($) { my ($str) = @_; - # git would never do this to us: + # git would never do this to us, mail diff uses // to prevent anchors: return if index($str, '//') >= 0; my $first = ''; @@ -135,6 +145,15 @@ sub to_attr ($) { sub ts2str ($) { strftime('%Y%m%d%H%M%S', gmtime($_[0])) }; # human-friendly format -sub fmt_ts ($) { strftime('%Y-%m-%d %k:%M', gmtime($_[0])) } +sub fmt_ts ($) { + # strftime %k is not portable and leading zeros in %H slow me down + my (undef, $M, $H, $d, $m, $Y) = gmtime $_[0]; + sprintf '%u-%02u-%02u % 2u:%02u', $Y + 1900, $m + 1, $d, $H, $M; +} + +sub utf8_maybe ($) { + utf8::decode($_[0]); + utf8::valid($_[0]) or utf8::encode($_[0]); # non-UTF-8 data exists +} 1; |