SL/Presenter/EscapedText.pm

   1 package SL::Presenter::EscapedText;
   2
   3 use strict;
   4 use Exporter qw(import);
   5
   6 our @EXPORT_OK = qw(escape is_escaped escape_js);
   7 our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
   8
   9 use JSON ();
  10
  11 use overload '""' => \&escaped_text;
  12
  13 my %html_entities = (
  14   '<' => '&lt;',
  15   '>' => '&gt;',
  16   '&' => '&amp;',
  17   '"' => '&quot;',
  18   "'" => '&apos;',
  19 );
  20
  21 # static constructors
  22 sub new {
  23   my ($class, %params) = @_;
  24
  25   return $params{text} if ref($params{text}) eq $class;
  26
  27   my $self      = bless {}, $class;
  28   $self->{text} = $params{is_escaped} ? $params{text} : quote_html($params{text});
  29
  30   return $self;
  31 }
  32
  33 sub quote_html {
  34   return undef unless defined $_[0];
  35   (my $x = $_[0]) =~ s/(["'<>&])/$html_entities{$1}/ge;
  36   $x
  37 }
  38
  39 sub escape {
  40   __PACKAGE__->new(text => $_[0]);
  41 }
  42
  43 sub is_escaped {
  44   __PACKAGE__->new(text => $_[0], is_escaped => 1);
  45 }
  46
  47 sub escape_js {
  48   my ($text) = @_;
  49
  50   $text =~ s|\\|\\\\|g;
  51   $text =~ s|\"|\\\"|g;
  52   $text =~ s|\n|\\n|g;
  53
  54   __PACKAGE__->new(text => $text, is_escaped => 1);
  55 }
  56
  57 # internal magic
  58 sub escaped_text {
  59   my ($self) = @_;
  60   return $self->{text};
  61 }
  62
  63 sub TO_JSON {
  64   goto &escaped_text;
  65 }
  66
  67 1;
  68 __END__
  69
  70 =pod
  71
  72 =encoding utf8
  73
  74 =head1 NAME
  75
  76 SL::Presenter::EscapedText - Thin proxy object to invert the burden of escaping HTML output
  77
  78 =head1 SYNOPSIS
  79
  80   use SL::Presenter::EscapedText qw(escape is_escaped escape_js);
  81
  82   sub blackbox {
  83     my ($text) = @_;
  84     return SL::Presenter::EscapedText->new(text => $text);
  85
  86     # or shorter:
  87     # return escape($text);
  88   }
  89
  90   sub build_output {
  91     my $output_of_other_component = blackbox('Hello & Goodbye');
  92
  93     # The following is safe, text will not be escaped twice:
  94     return SL::Presenter::EscapedText->new(text => $output_of_other_component);
  95   }
  96
  97   my $output = build_output();
  98   print "Yeah: $output\n";
  99
 100 =head1 OVERVIEW
 101
 102 Sometimes it's nice to let a sub-component build its own
 103 representation. However, you always have to be very careful about
 104 whose responsibility escaping is. Only the building function knows
 105 enough about the structure to be able to HTML escape properly.
 106
 107 But higher functions should not have to care if the output is already
 108 escaped -- they should be able to simply escape it again. Without
 109 producing stuff like '&amp;amp;'.
 110
 111 Stringification is overloaded. It will return the same as L<escaped_text>.
 112
 113 This works together with the template plugin
 114 L<SL::Template::Plugin::P> and its C<escape> method.
 115
 116 =head1 FUNCTIONS
 117
 118 =over 4
 119
 120 =item C<new %params>
 121
 122 Creates an instance of C<EscapedText>.
 123
 124 The parameter C<text> is the text to escape. If it is already an
 125 instance of C<EscapedText> then C<$params{text}> is returned
 126 unmodified.
 127
 128 Otherwise C<text> is HTML-escaped and stored in the new instance. This
 129 can be overridden by setting C<$params{is_escaped}> to a trueish
 130 value.
 131
 132 =item C<escape $text>
 133
 134 Static constructor, can be exported. Equivalent to calling C<< new(text => $text) >>.
 135
 136 =item C<is_escaped $text>
 137
 138 Static constructor, can be exported. Equivalent to calling C<< new(text => $text, escaped => 1) >>.
 139
 140 =item C<escape_js $text>
 141
 142 Static constructor, can be exported. Like C<escape> but also escapes Javascript.
 143
 144 =back
 145
 146 =head1 METHODS
 147
 148 =over 4
 149
 150 =item C<escaped_text>
 151
 152 Returns the escaped string (not an instance of C<EscapedText> but an
 153 actual string).
 154
 155 =back
 156
 157 =head1 BUGS
 158
 159 Nothing here yet.
 160
 161 =head1 AUTHOR
 162
 163 Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
 164
 165 =cut