lib/HTML/String/TT/Directive.pm

   1 package HTML::String::TT::Directive;
   2
   3 use strictures 1;
   4 use HTML::String::Overload ();
   5 use Data::Munge;
   6 use B qw(perlstring);
   7 use base qw(Template::Directive);
   8
   9 sub template {
  10     return byval {
  11         s/sub {/sub { package HTML::String::TT::_TMPL; use HTML::String::Overload { ignore => { q{Template::Provider} => 1, q{Template::Directive} => 1, q{Template::Document} => 1, q{Template::Plugins} => 1 } };/;
  12     } Template::Directive::pad(shift->SUPER::template(@_), 2);
  13 }
  14
  15 # TT code does &text(), no idea why
  16
  17 sub textblock {
  18     my ($self, $text) = @_;
  19     return $Template::Directive::OUTPUT.' '.$self->text($text).';';
  20 }
  21
  22 # https://rt.perl.org/rt3/Ticket/Display.html?id=49594
  23
  24 sub text {
  25     my ($class, $text) = @_;
  26
  27     # We need to turn everything into escapes, including wide chars
  28     # that will end up as e.g. \342\200\223 if 'use utf8' isn't in
  29     # scope or \x{...} if it is. So we run it through perlstring first
  30     # so everything is already a backslash escape sequence (because the
  31     # exact same bug can apply to wide chars in place), and then hit
  32     # it with an ugly regexp to turn it into e.g.
  33     #
  34     #   "<li>foo "."\342".""."\200".""."\223"." bar.</li>"
  35     #
  36     # which then gets overload::constant'ed appropriately.
  37
  38     # The first two lines of the s! were assembled from the escape sequences
  39     # table in "Quote and Quote-like Operators" in perlop by Lucas Mai, then
  40     # the last line handles sigils.
  41
  42     my $str = perlstring $text;
  43     $str =~ s!
  44       \\ ( [abefnrt] | c. | o \{ [0-7]+ \} | x (?: \{ [[:xdigit:]]+ \}
  45            | [[:xdigit:]]{1,2} ) | N \{ [^{}]* \} | [0-7]{1,3}
  46            | \$ | \@ )
  47       !"."\\$1"."!xg;
  48
  49     return $str;
  50 }
  51
  52 1;
  53
  54 __END__
  55
  56 =head1 NAME
  57
  58 HTML::String::TT::Directive - L<Template::Directive> overrides to forcibly escape HTML strings
  59
  60 =head1 SYNOPSIS
  61
  62 This is not user serviceable, and is documented only for your edification.
  63
  64 Please use L<HTML::String::TT> as this module could change, be renamed, or
  65 if I figure out a better way of implementing the functionality disappear
  66 entirely at any moment.
  67
  68 =head1 METHODS
  69
  70 =head2 template
  71
  72 We override this top-level method in order to pretend two things to the
  73 perl subroutine definition that TT has generated - firstly,
  74
  75   package HTML::String::TT::_TMPL;
  76
  77 to ensure that no packages marked to be ignored are the current one when
  78 the template code is executed. Secondly,
  79
  80   use HTML::String::Overload { ignore => { ... } };
  81
  82 where the C<...> contains a list of TT internal packages to ignore so that
  83 things actually work. This list is not duplicated here since it may also
  84 change without warning.
  85
  86 Additionally, the hashref option to L<HTML::String::Overload> is not
  87 documented there since I'm not yet convinced that's a public API either.
  88
  89 =head2 text
  90
  91 Due to a perl bug (L<https://rt.perl.org/rt3/Ticket/Display.html?id=49594>)
  92 we overload this method to change
  93
  94   "<foo>\n<bar>"
  95
  96 into
  97
  98   "<foo>"."\n"."<bar>"
  99
 100 since any string containing a backslash escape doesn't get marked as HTML.
 101 Since we don't want to escape things that backslash escapes are normally
 102 used for, this isn't really a problem for us.
 103
 104 =head2 textblock
 105
 106 For no reason I can comprehend at all, L<Template::Directive>'s C<textblock>
 107 method calls C<&text> instead of using a method call so we have to override
 108 this as well.
 109
 110 =head1 AUTHORS
 111
 112 See L<HTML::String> for authors.
 113
 114 =head1 COPYRIGHT AND LICENSE
 115
 116 See L<HTML::String> for the copyright and license.
 117
 118 =cut