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