1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
package FixMyStreet::Template::SafeString;
use strict;
use warnings;
=head1 NAME
FixMyStreet::Template::SafeString - a string that won't be escaped on output in a template
=cut
use overload
'""' => sub { ${$_[0]} },
'.' => \&concat,
'.=' => \&concatequals,
'=' => \&clone,
'cmp' => \&cmp,
;
sub new {
my ($class, $value) = @_;
my $self = bless \$value, $class;
return $self;
}
sub cmp {
my ($self, $str) = @_;
if (ref $str eq __PACKAGE__) {
return $$self cmp $$str;
} else {
return $$self cmp $str;
}
}
sub concat {
my ($self, $str, $prefix) = @_;
return $self->clone() if not defined $str or $str eq '';
if ( $prefix ) {
return $str . $$self;
} else {
return $$self . $str;
}
}
sub concatequals {
my ($self, $str, $prefix) = @_;
if ( ref $str eq __PACKAGE__) {
$$self .= $$str;
return $self;
} else {
return $self->clone() if $str eq '';
$$self .= $str;
return $$self;
}
}
sub clone {
my $self = shift;
my $val = $$self;
my $clone = bless \$val, ref $self;
return $clone;
}
sub TO_JSON {
my $self = shift;
return $$self;
}
1;
__END__
=head1 SYNOPSIS
use FixMyStreet::Template;
use FixMyStreet::Template::SafeString;
my $s1 = "< test & stuff >";
my $s2 = FixMyStreet::Template::SafeString->new($s1);
my $tt = FixMyStreet::Template->new();
$tt->process(\"[% s1 %] * [% s2 %]\n", { s1 => $s1, s2 => $s2 });
# Produces output "< test & stuff > * < test & stuff >"
=head1 DESCRIPTION
This object provides a safe string to use as part of the FixMyStreet::Template
extension. It will not be automatically escaped when used, so can be used to
pass HTML to a template by a function that is safely creating some.
=head1 AUTHOR
Matthew Somerville, E<lt>matthew@mysociety.orgE<gt>
Martyn Smith, E<lt>msmith@cpan.orgE<gt>
=head1 LICENSE
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
|
