kivitendo/SL/Presenter/EscapedText.pm @ 983b4461
| d4458803 | Moritz Bunkus | package SL::Presenter::EscapedText;
|
||
use strict;
|
||||
| 0e5e3501 | Sven Schöling | use Exporter qw(import);
|
||
| 1e0c2679 | Sven Schöling | use Scalar::Util qw(looks_like_number);
|
||
| 0e5e3501 | Sven Schöling | |||
| 1e0c2679 | Sven Schöling | our @EXPORT_OK = qw(escape is_escaped escape_js escape_js_call);
|
||
| 0e5e3501 | Sven Schöling | our %EXPORT_TAGS = (ALL => \@EXPORT_OK);
|
||
| d4458803 | Moritz Bunkus | |||
| 7647d46a | Moritz Bunkus | use JSON ();
|
||
| 0e5e3501 | Sven Schöling | use overload '""' => \&escaped_text;
|
||
| d4458803 | Moritz Bunkus | |||
| be5cae09 | Sven Schöling | my %html_entities = (
|
||
'<' => '<',
|
||||
'>' => '>',
|
||||
'&' => '&',
|
||||
'"' => '"',
|
||||
"'" => ''',
|
||||
);
|
||||
| 0e5e3501 | Sven Schöling | # static constructors
|
||
| d4458803 | Moritz Bunkus | sub new {
|
||
my ($class, %params) = @_;
|
||||
return $params{text} if ref($params{text}) eq $class;
|
||||
my $self = bless {}, $class;
|
||||
| be5cae09 | Sven Schöling | $self->{text} = $params{is_escaped} ? $params{text} : quote_html($params{text});
|
||
| d4458803 | Moritz Bunkus | |||
return $self;
|
||||
}
|
||||
| be5cae09 | Sven Schöling | sub quote_html {
|
||
return undef unless defined $_[0];
|
||||
(my $x = $_[0]) =~ s/(["'<>&])/$html_entities{$1}/ge;
|
||||
$x
|
||||
}
|
||||
| 0e5e3501 | Sven Schöling | sub escape {
|
||
__PACKAGE__->new(text => $_[0]);
|
||||
}
|
||||
sub is_escaped {
|
||||
__PACKAGE__->new(text => $_[0], is_escaped => 1);
|
||||
}
|
||||
sub escape_js {
|
||||
my ($text) = @_;
|
||||
$text =~ s|\\|\\\\|g;
|
||||
$text =~ s|\"|\\\"|g;
|
||||
$text =~ s|\n|\\n|g;
|
||||
__PACKAGE__->new(text => $text, is_escaped => 1);
|
||||
}
|
||||
| 1e0c2679 | Sven Schöling | sub escape_js_call {
|
||
my ($func, @args) = @_;
|
||||
escape(
|
||||
sprintf "%s(%s)",
|
||||
escape_js($func),
|
||||
join ", ", map {
|
||||
looks_like_number($_)
|
||||
? $_
|
||||
: '"' . escape_js($_) . '"'
|
||||
} @args
|
||||
);
|
||||
}
|
||||
| 0e5e3501 | Sven Schöling | # internal magic
|
||
sub escaped_text {
|
||||
| d4458803 | Moritz Bunkus | my ($self) = @_;
|
||
return $self->{text};
|
||||
}
|
||||
| 7647d46a | Moritz Bunkus | sub TO_JSON {
|
||
| 0e5e3501 | Sven Schöling | goto &escaped_text;
|
||
| 7647d46a | Moritz Bunkus | }
|
||
| d4458803 | Moritz Bunkus | 1;
|
||
__END__
|
||||
=pod
|
||||
=encoding utf8
|
||||
=head1 NAME
|
||||
| 0e5e3501 | Sven Schöling | SL::Presenter::EscapedText - Thin proxy object to invert the burden of escaping HTML output
|
||
| d4458803 | Moritz Bunkus | |||
=head1 SYNOPSIS
|
||||
| 0e5e3501 | Sven Schöling | use SL::Presenter::EscapedText qw(escape is_escaped escape_js);
|
||
| d4458803 | Moritz Bunkus | |||
sub blackbox {
|
||||
my ($text) = @_;
|
||||
return SL::Presenter::EscapedText->new(text => $text);
|
||||
| 0e5e3501 | Sven Schöling | |||
# or shorter:
|
||||
# return escape($text);
|
||||
| d4458803 | Moritz Bunkus | }
|
||
sub build_output {
|
||||
my $output_of_other_component = blackbox('Hello & Goodbye');
|
||||
# The following is safe, text will not be escaped twice:
|
||||
return SL::Presenter::EscapedText->new(text => $output_of_other_component);
|
||||
}
|
||||
my $output = build_output();
|
||||
print "Yeah: $output\n";
|
||||
=head1 OVERVIEW
|
||||
Sometimes it's nice to let a sub-component build its own
|
||||
representation. However, you always have to be very careful about
|
||||
whose responsibility escaping is. Only the building function knows
|
||||
enough about the structure to be able to HTML escape properly.
|
||||
But higher functions should not have to care if the output is already
|
||||
escaped -- they should be able to simply escape it again. Without
|
||||
producing stuff like '&amp;'.
|
||||
| 0e5e3501 | Sven Schöling | Stringification is overloaded. It will return the same as L<escaped_text>.
|
||
| d4458803 | Moritz Bunkus | |||
This works together with the template plugin
|
||||
L<SL::Template::Plugin::P> and its C<escape> method.
|
||||
=head1 FUNCTIONS
|
||||
=over 4
|
||||
=item C<new %params>
|
||||
Creates an instance of C<EscapedText>.
|
||||
The parameter C<text> is the text to escape. If it is already an
|
||||
instance of C<EscapedText> then C<$params{text}> is returned
|
||||
unmodified.
|
||||
Otherwise C<text> is HTML-escaped and stored in the new instance. This
|
||||
can be overridden by setting C<$params{is_escaped}> to a trueish
|
||||
value.
|
||||
| 0e5e3501 | Sven Schöling | =item C<escape $text>
|
||
Static constructor, can be exported. Equivalent to calling C<< new(text => $text) >>.
|
||||
=item C<is_escaped $text>
|
||||
Static constructor, can be exported. Equivalent to calling C<< new(text => $text, escaped => 1) >>.
|
||||
=item C<escape_js $text>
|
||||
Static constructor, can be exported. Like C<escape> but also escapes Javascript.
|
||||
| 1e0c2679 | Sven Schöling | =item C<escape_js_call $func_name, @args>
|
||
Static constructor, can be exported. Used to construct a javascript call than
|
||||
can be used for onclick handlers in other Presenter functions.
|
||||
For example:
|
||||
L.button_tag(
|
||||
P.escape_js_call("kivi.Package.some_func", arg_one, arg_two, arg_three)
|
||||
title
|
||||
)
|
||||
| 0e5e3501 | Sven Schöling | =back
|
||
=head1 METHODS
|
||||
=over 4
|
||||
=item C<escaped_text>
|
||||
| d4458803 | Moritz Bunkus | |||
Returns the escaped string (not an instance of C<EscapedText> but an
|
||||
actual string).
|
||||
=back
|
||||
=head1 BUGS
|
||||
Nothing here yet.
|
||||
=head1 AUTHOR
|
||||
Moritz Bunkus E<lt>m.bunkus@linet-services.deE<gt>
|
||||
=cut
|