diff options
Diffstat (limited to 'perllib/FixMyStreet/Template')
| -rw-r--r-- | perllib/FixMyStreet/Template/Context.pm | 67 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Template/SafeString.pm | 106 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Template/Stash.pm | 75 | ||||
| -rw-r--r-- | perllib/FixMyStreet/Template/Variable.pm | 177 |
4 files changed, 425 insertions, 0 deletions
diff --git a/perllib/FixMyStreet/Template/Context.pm b/perllib/FixMyStreet/Template/Context.pm new file mode 100644 index 000000000..de3212095 --- /dev/null +++ b/perllib/FixMyStreet/Template/Context.pm @@ -0,0 +1,67 @@ +package FixMyStreet::Template::Context; + +use strict; +use warnings; +use base qw(Template::Context); + +sub filter { + my $self = shift; + my ($name, $args, $alias) = @_; + + # If we're passing through the safe filter, then unwrap + # from a Template::HTML::Variable if we are one. + if ( $name eq 'safe' ) { + return sub { + my $value = shift; + return $value->plain if UNIVERSAL::isa($value, 'FixMyStreet::Template::Variable'); + return $value; + }; + } + + my $filter = $self->SUPER::filter(@_); + + # If we are already going to auto-encode, we don't want to do it again. + # This makes the html filter a no-op on auto-encoded variables. + if ( $name eq 'html' ) { + return sub { + my $value = shift; + return $value if UNIVERSAL::isa($value, 'FixMyStreet::Template::Variable'); + return $filter->($value); + }; + } + + return sub { + my $value = shift; + + if ( UNIVERSAL::isa($value, 'FixMyStreet::Template::Variable') ) { + my $result = $filter->($value->plain); + return $result if UNIVERSAL::isa($result, 'FixMyStreet::Template::SafeString'); + return ref($value)->new($result); + } + + return $filter->($value); + }; +} + +1; +__END__ + +=head1 NAME + +FixMyStreet::Template::Context - Similar to Template::HTML::Context but use +'safe' rather than 'none' to be clear, also prevents html filter double-encoding, +and doesn't rewrap a FixMyStreet::Template::SafeString. + +=head1 AUTHORS + +Martyn Smith, E<lt>msmith@cpan.orgE<gt> + +Matthew Somerville, E<lt>matthew@mysociety.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 diff --git a/perllib/FixMyStreet/Template/SafeString.pm b/perllib/FixMyStreet/Template/SafeString.pm new file mode 100644 index 000000000..619bee048 --- /dev/null +++ b/perllib/FixMyStreet/Template/SafeString.pm @@ -0,0 +1,106 @@ +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; +} + +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 diff --git a/perllib/FixMyStreet/Template/Stash.pm b/perllib/FixMyStreet/Template/Stash.pm new file mode 100644 index 000000000..dd027400e --- /dev/null +++ b/perllib/FixMyStreet/Template/Stash.pm @@ -0,0 +1,75 @@ +package FixMyStreet::Template::Stash; + +use strict; +use warnings; +use base qw(Template::Stash); +use FixMyStreet::Template::Variable; +use Scalar::Util qw(blessed); + +sub get { + my $self = shift; + + my $value = $self->SUPER::get(@_); + + $value = FixMyStreet::Template::Variable->new($value) unless ref $value; + + return $value; +} + +# To deal with being able to call var.upper or var.match +sub _dotop { + my $self = shift; + my ($root, $item, $args, $lvalue) = @_; + + $args ||= [ ]; + $lvalue ||= 0; + + return undef unless defined($root) and defined($item); + return undef if $item =~ /^[_.]/; + + if (blessed($root) && $root->isa('FixMyStreet::Template::Variable')) { + if ((my $value = $Template::Stash::SCALAR_OPS->{ $item }) && ! $lvalue) { + my @result = &$value($root->{value}, @$args); + if (defined $result[0]) { + return scalar @result > 1 ? [ @result ] : $result[0]; + } + return undef; + } + } + + return $self->SUPER::_dotop(@_); +} + +1; +__END__ + +=head1 NAME + +FixMyStreet::Template::Stash - The same as Template::HTML::Stash, but +additionally copes with scalar operations on stash items. + +=head1 FUNCTIONS + +=head2 get() + +An overridden function from Template::Stash that calls the parent class's get +method, and returns a FixMyStreet::Template::Variable instead of a raw string. + +=head2 _dotop() + +An overridden function from Template::Stash so that scalar operations on +wrapped FixMyStreet::Template::Variable strings still function correctly. + +=head1 AUTHOR + +Martyn Smith, E<lt>msmith@cpan.orgE<gt> + +Matthew Somerville, E<lt>matthew@mysociety.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 diff --git a/perllib/FixMyStreet/Template/Variable.pm b/perllib/FixMyStreet/Template/Variable.pm new file mode 100644 index 000000000..9b5a0fcc4 --- /dev/null +++ b/perllib/FixMyStreet/Template/Variable.pm @@ -0,0 +1,177 @@ +package FixMyStreet::Template::Variable; + +use strict; +use warnings; +use FixMyStreet::Template; + +sub op_factory { + my ($op) = @_; + + return eval q|sub { + my ($self, $str) = @_; + + if ( ref $str eq __PACKAGE__) { + return $self->{value} | . $op . q| $str->{value}; + } + else { + return $self->{value} | . $op . q| $str; + } + }|; +} + +use overload + '""' => \&html_encoded, + '.' => \&concat, + '.=' => \&concatequals, + '=' => \&clone, + + 'cmp' => op_factory('cmp'), + 'eq' => op_factory('eq'), + '<=>' => op_factory('<=>'), + '==' => op_factory('=='), + '%' => op_factory('%'), + '+' => op_factory('+'), + '-' => op_factory('-'), + '*' => op_factory('*'), + '/' => op_factory('/'), + '**' => op_factory('**'), + '>>' => op_factory('>>'), + '<<' => op_factory('<<'), +; + +sub new { + my ($class, $value) = @_; + + my $self = bless { value => $value }, $class; + + return $self; +} + +sub plain { + my $self = shift; + + return $self->{value}; +} + +sub html_encoded { + my $self = shift; + return FixMyStreet::Template::html_filter($self->{value}); +} + +sub concat { + my ($self, $str, $prefix) = @_; + + # Special case where we're _not_ going to html_encode now now + return $self->clone() if not defined $str or $str eq ''; + + if ( $prefix ) { + return $str . $self->html_encoded(); + } + else { + return $self->html_encoded() . $str; + } +} + +sub concatequals { + my ($self, $str, $prefix) = @_; + + if ( ref $str eq __PACKAGE__) { + $self->{value} .= $str->{value}; + return $self; + } + else { + # Special case where we're _not_ going to html_encode now now + return $self->clone() if $str eq ''; + + # Fix Template::HTML::Variable issue with double output + my $ret = $self->html_encoded . $str; + $self->{value} .= $str; + return $ret; + } +} + +sub clone { + my $self = shift; + + my $clone = bless { %$self }, ref $self; + + return $clone; +} + +1; +__END__ + +=head1 NAME + +FixMyStreet::Template::Variable - A "pretend" string that auto HTML encodes; +a copy of Template::HTML::Variable with a bugfix. + +=head1 SYNOPSIS + + use FixMyStreet::Template::Variable; + + my $string = FixMyStreet::Template::Variable->new('< test & stuff >'); + + print $string, "\n"; + + # Produces output "< test & stuff >" + +=head1 DESCRIPTION + +This object provides a "pretend" string to use as part of the +FixMyStreet::Template extension. + +It automatically stringifies to an HTML encoded version of what it was created +with, all the while trying to keep a sane state through string concatinations +etc. + +=head1 FUNCTIONS + +=head2 new() + +Takes a single argument which is the string to set this variable to + +=head2 plain() + +Returns a non HTML-encoded version of the string (i.e. exactly what was passed +to the new() function + +=head2 html_encoded() + +Returns an HTML encoded version of the string (used by the stringify +overloads) + +=head2 concat() + +Implementation of overloaded . operator + +=head2 concatequals() + +Implementation of overloaded .= operator. + +The original Template::HTML::Variable has a bug here, whereby it adds the new +string to its internal value, then returns the HTML encoded version of the +whole string with the new string concatenated again (unescaped). + +=head2 clone() + +Returns a clone of this variable. (used for the implementation of the +overloaded = operator). + +=head2 op_factory() + +Factory for generating operator overloading subs + +=head1 AUTHOR + +Martyn Smith, E<lt>msmith@cpan.orgE<gt> + +Matthew Somerville, E<lt>matthew@mysociety.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 |