diff options
Diffstat (limited to 'perllib/FixMyStreet/Template.pm')
-rw-r--r-- | perllib/FixMyStreet/Template.pm | 143 |
1 files changed, 143 insertions, 0 deletions
diff --git a/perllib/FixMyStreet/Template.pm b/perllib/FixMyStreet/Template.pm index 6317f7552..275089a35 100644 --- a/perllib/FixMyStreet/Template.pm +++ b/perllib/FixMyStreet/Template.pm @@ -7,10 +7,14 @@ use FixMyStreet; use mySociety::Locale; use Attribute::Handlers; use HTML::Scrubber; +use HTML::TreeBuilder; use FixMyStreet::Template::SafeString; use FixMyStreet::Template::Context; use FixMyStreet::Template::Stash; +use RABX; +use IO::String; + my %FILTERS; my %SUBS; @@ -141,6 +145,8 @@ sub html_paragraph : Filter('html_para') { sub sanitize { my $text = shift; + $text = $$text if UNIVERSAL::isa($text, 'FixMyStreet::Template::SafeString'); + my %allowed_tags = map { $_ => 1 } qw( p ul ol li br b i strong em ); my $scrubber = HTML::Scrubber->new( rules => [ @@ -155,4 +161,141 @@ sub sanitize { return $text; } +=head2 email_sanitize_text + +Intended for use in the _email_comment_list.txt template to allow HTML +in updates from staff/superusers. Sanitizes the HTML and then converts +it all to text. + +=cut + +sub email_sanitize_text : Fn('email_sanitize_text') { + my $update = shift; + + my $text = $update->{item_text}; + my $extra = $update->{item_extra}; + utf8::encode($extra) if $extra; + $extra = $extra ? RABX::wire_rd(new IO::String($extra)) : {}; + + my $staff = $extra->{is_superuser} || $extra->{is_body_user}; + + return $text unless $staff; + + $text = FixMyStreet::Template::sanitize($text); + + my $tree = HTML::TreeBuilder->new_from_content($text); + _sanitize_elt($tree); + + return $tree->as_text; +} + +my $list_type; +my $list_num; +my $sanitize_text_subs = { + b => [ '*', '*' ], + strong => [ '*', '*' ], + i => [ '_', '_' ], + em => [ '_', '_' ], + p => [ '', "\n\n" ], + li => [ '', "\n\n" ], +}; +sub _sanitize_elt { + my $elt = shift; + foreach ($elt->content_list) { + next unless ref $_; + $list_type = $_->tag, $list_num = 1 if $_->tag eq 'ol' || $_->tag eq 'ul'; + _sanitize_elt($_); + $_->replace_with("\n") if $_->tag eq 'br'; + $_->replace_with('[image: ', $_->attr('alt'), ']') if $_->tag eq 'img'; + $_->replace_with($_->as_text, ' [', $_->attr('href'), ']') if $_->tag eq 'a'; + $_->replace_with_content if $_->tag eq 'span' || $_->tag eq 'font'; + $_->replace_with_content if $_->tag eq 'ul' || $_->tag eq 'ol'; + if ($_->tag eq 'li') { + $sanitize_text_subs->{li}[0] = $list_type eq 'ol' ? "$list_num. " : '* '; + $list_num++; + } + if (my $sub = $sanitize_text_subs->{$_->tag}) { + $_->preinsert($sub->[0]); + $_->postinsert($sub->[1]); + $_->replace_with_content; + } + } +} + +=head2 email_sanitize_html + +Intended for use in the _email_comment_list.html template to allow HTML +in updates from staff/superusers. + +=cut + +sub email_sanitize_html : Fn('email_sanitize_html') { + my $update = shift; + + my $text = $update->{item_text}; + my $extra = $update->{item_extra}; + utf8::encode($extra) if $extra; + $extra = $extra ? RABX::wire_rd(new IO::String($extra)) : {}; + + my $staff = $extra->{is_superuser} || $extra->{is_body_user}; + + return _staff_html_markup($text, $staff); +} + +sub _staff_html_markup { + my ( $text, $staff ) = @_; + unless ($staff) { + return html_paragraph(add_links($text)); + } + + $text = sanitize($text); + + # Apply Markdown-style italics + $text =~ s{\*(\S.*?\S)\*}{<i>$1</i>}; + + # Mark safe so add_links doesn't escape everything. + $text = FixMyStreet::Template::SafeString->new($text); + + $text = add_links($text); + + # If the update already has block-level elements then don't wrap + # individual lines in <p> elements, as we assume the user knows what + # they're doing. + unless ($text =~ /<(p|ol|ul)>/) { + $text = html_paragraph($text); + } + + return $text; +} + +=head2 add_links + + [% text | add_links | html_para %] + +Add some links to some text (and thus HTML-escapes the other text). + +=cut + +sub add_links { + my $text = shift; + $text = conditional_escape($text); + $text =~ s/\r//g; + $text =~ s{(?<!["'])(https?://)([^\s]+)}{"<a href=\"$1$2\">$1" . _space_slash($2) . '</a>'}ge; + return FixMyStreet::Template::SafeString->new($text); +} + +sub _space_slash { + my $t = shift; + $t =~ s{/(?!$)}{/ }g; + return $t; +} + +sub title : Filter { + my $text = shift; + $text =~ s{(\w[\w']*)}{\u\L$1}g; + # Postcode special handling + $text =~ s{(\w?\w\d[\d\w]?\s*\d\w\w)}{\U$1}g; + return $text; +} + 1; |