SL/Presenter/EscapedText.pm

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